函数调用导致类型13不匹配

如此接近完成一个大型项目，但似乎无法克服这种不匹配。任何帮助，将不胜感激。希望这不是太多信息...

获取.xlsx单张文件，并需要使用交叉引用表将信息添加到新书中的数据中，以获取营业日期和期间。这是源书的示例：

样本数据片段

我从@PGSystemTester那里获得了这段代码，作为一个vlookup解决方案，它使用一个日期从参考表中提取数据，该日期介于参考表上不同列的日期之间。

Function rngLOOKUP(chkDate As Date, rngf As Range, theColumn As Long) As Variant
Dim acell As Range

For Each acell In rngf.Columns(1).Cells
    If acell.Value <= chkDate And acell.Offset(0, 1).Value >= chkDate Then
        rngLOOKUP = acell.Offset(0, theColumn - 1).Value
        Exit Function
    End If
Next acell

rngLOOKUP = "#Nothing"

End Function

我已经搜索并尝试了数十种方法来设置日期格式，但无法克服类型不匹配的问题，并且开始怀疑是否实际上是日期问题所在：

这是交叉引用表的示例：

对照表样本

每次我使用此调用将结果分配给变量时，都会遇到运行时错误13，键入不匹配：

fYear = rngLOOKUP(aDate, rng, 3)

这是完整的代码。源文件是.xlsx，我将日期来自的单元格格式化后再将其分配给变量。

Sub CleanDaily_Labour()
'
' CleanDaily_Labour Macro
' RMDC Payroll Resarch (MU) Report prep
'


    Dim myPath, fName, refFILE, job, JobGR, DateST, WKDay, PDWK, fYear As String
    Dim CRef, wkb As Workbook
    Dim shtDATE, shtJOB, sht As Worksheet
    Dim aDate, fYR As Date
    Dim rngLOOKUP As Variant
    Dim rng, rngJOBS, rngJBGRP As Range
    Dim SC, lastRow, PD, WK As Long

    Application.ScreenUpdating = False
    myPath = Application.ActiveWorkbook.Path
'
' Get the file date and assign to variables
'
    Range("D3").Select
    Selection.NumberFormat = "yyyy-mm-dd"
    aDate = Range("D3").Value
    DateST = WorksheetFunction.Text(aDate, "YYYYMMDD")
    WKDay = WorksheetFunction.Text(aDate, "DDD")

    Selection.Copy
    Range("D7").Select
    ActiveSheet.Paste
'
' Rename and save the active workbook by date
' set wkb to new workbook name and assign calendar cross ref
'
    fName = myPath & "\Daily_Labour" _
        & DateST & ".xlsx"
    ActiveWorkbook.SaveAs fName, 51
    Set wkb = Workbooks.Open(fName)
    Set sht = wkb.Sheets("Sheet1")


    refFILE = myPath & "\Cross_Ref_fCalendar.xlsx"

'
' Remove extra header info
'
    Rows("1:5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
'
'   Insert Column to the left of Column D
'
    Columns("E:G").Insert Shift:=xlToRight, _
      CopyOrigin:=xlFormatFromRightOrBelow
'
' Update Headers that will be kept / used
'
    Range("A1").Value = "FYear"
    Range("E1").Value = "PD_WK"
    Range("J1").Value = "JOB_GRP"
    Range("F1").Value = "WKDay"
    Range("G1").Value = "PD"
    Range("H1").Value = "WK"
'
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
'
' Remove extra columns
'
    Sheets("Sheet1").Range("K:K,M:P,R:AY").EntireColumn.Delete
'
' Get the last row and fill known columns
'
    lastRow = Cells(Rows.Count, 1).End(xlUp).row
    Range("d2:d" & lastRow).Value = aDate
    'Range("d2:d" & lastRow).NumberFormat = "dd-mmm-yy" (commented as no impact on error, tried variantions here to overcome mismatch but should not matter as variable never changed here, just the range)
    Range("f2:f" & lastRow).Value = WKDay
'
' Set variables for next steps
'
    Set CRef = Workbooks.Open(refFILE)
    Set shtJOB = CRef.Sheets("JobCross")
    Set shtDATE = CRef.Sheets("fcalendar")
    sht.Activate
    Set rngJOBS = Range("i2:i" & lastRow)
    Set rngJBGRP = shtJOB.Range("A1:b16")
    Set rng = shtDATE.Range("A2:f210")
'
' Loop through jobs in column i match job in shtJOB
' put matching group in row j (Use Function vLookupVBA)
'
    For Each jRow In rngJOBS
        jRow.Select
        job = ActiveCell.Value
        JobGR = VLookupVBA(job, rngJBGRP, Null)
        ActiveCell.Offset(0, 1).Value = JobGR
    'end for
   Next jRow
'
'Save Progress during testing:
'
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs fName, 51
'
' Fill in date parameters from Cross Ref file for Business date
' Use function rngLOOKUP to update variables then set ranges to the variables
' May be more efficient to get row number from cross ref table instead - later.
'
'    shtDATE.Activate (does not seem to affect)
'
    fYear = rngLOOKUP(aDate, rng, 3) '**This results in the error**
    PDWK = rngLOOKUP(aDate, rng, 6)
    PD = rngLOOKUP(aDate, rng, 4)
    WK = rngLOOKUP(aDate, rng, 5)
'
' Fill the columns with the variables (can likely bypass the variables and put on 1 line)- later
'
    Range("A2:A" & lastRow).Value = fYear
    Range("E2:E" & lastRow).Value = PDWK
    Range("G2:G" & lastRow).Value = PD
    Range("H2:H" & lastRow).Value = WK
'
' Cleanup, save and close workbooks
'
    Application.DisplayAlerts = False
    CRef.Close False
    wkb.SaveAs fName, 51
'
' SQL call: Load to existing datbase (GDrive), use same format as Transactions
' ?? Get sales by day? vs maintain PDWK
'
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True



End Sub