函数调用导致类型 13 不匹配
Function call results in type 13 mismatch
如此接近完成一个大型项目,但似乎无法克服这种不匹配。任何帮助,将不胜感激。希望这不是太多信息...
获取 .xlsx 单个 sheet 文件并需要使用交叉引用 table 将信息添加到新书中的数据以获取业务日期和期间。这是原始资料的示例:
Sample data snippet
我从@PGSystemTester 那里得到这段代码作为一个 vlookup 解决方案,使用一个日期从参考 table 中提取数据,该日期介于参考 table 上单独列中的日期之间。
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
我已经搜索并尝试了数十种格式化日期的方法,但无法解决类型不匹配问题,我开始怀疑是否真的是日期问题:
这是交叉引用的示例 table:
Cross reference table sample
每次我使用此调用将结果分配给变量时,我都会收到 运行 时间错误 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
rngLOOKUP() 的第一个参数需要一个日期,第二个参数需要一个范围。但是,您在每种情况下都将其传递给 Variant。因此,类型不匹配错误。例如,在您的代码中,您已将 aDate 声明如下...
Dim aDate, fYR As Date
这意味着 aDate 被声明为 Variant,而不是 Date,而 fYR 被声明为 Date。因此,您需要按如下方式更改声明声明...
Dim aDate as Date, fYR As Date
rng 也一样。而且,对于所有其他声明语句,它看起来都一样。
如此接近完成一个大型项目,但似乎无法克服这种不匹配。任何帮助,将不胜感激。希望这不是太多信息...
获取 .xlsx 单个 sheet 文件并需要使用交叉引用 table 将信息添加到新书中的数据以获取业务日期和期间。这是原始资料的示例:
Sample data snippet
我从@PGSystemTester 那里得到这段代码作为一个 vlookup 解决方案,使用一个日期从参考 table 中提取数据,该日期介于参考 table 上单独列中的日期之间。
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
我已经搜索并尝试了数十种格式化日期的方法,但无法解决类型不匹配问题,我开始怀疑是否真的是日期问题:
这是交叉引用的示例 table:
Cross reference table sample
每次我使用此调用将结果分配给变量时,我都会收到 运行 时间错误 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
rngLOOKUP() 的第一个参数需要一个日期,第二个参数需要一个范围。但是,您在每种情况下都将其传递给 Variant。因此,类型不匹配错误。例如,在您的代码中,您已将 aDate 声明如下...
Dim aDate, fYR As Date
这意味着 aDate 被声明为 Variant,而不是 Date,而 fYR 被声明为 Date。因此,您需要按如下方式更改声明声明...
Dim aDate as Date, fYR As Date
rng 也一样。而且,对于所有其他声明语句,它看起来都一样。