excel - Excel VBA：查找日期范围表中的日期行

在代码中处理了几个问题后，@PGTester 提供的函数效果很好：

1) 声明：每种类型的声明都在一行中。这在 VBA 中不起作用，因为只有最后一个变量被声明为预期的，而所有之前的变量都被声明为变体。（即，DIM adate、bdate、cdate 作为日期）在此示例中，只有 cdate 是实际日期。在更正声明之前，将日期传递给函数会导致不匹配。（@Domenic 指出了这一点）

2) 日期格式：虽然源文件和交叉引用文件中的所有日期在调用函数之前都被格式化为“yyyy-mmm-dd”，但错误 13，类型不匹配仍然阻止代码继续前进。将源文件（在代码中完成）和交叉引用表（在访问之前手动）上的格式更改为“md-yyyy”解决了这个问题，以下代码按预期工作。

3) 将函数调用指向 vlookup 和 rnglookup 的交叉引用文件是通过为所需页面构建和设置变量来完成的。这在需要时简化了选择。

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")

具有这两个功能的完整代码如下：

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

' Note the separate declarations for each variable
'    
    Dim myPath As String, fName As String, refFILE As String, job As String, _
      JobGR As String, DateST As String, WKDay As String, PDWK As String
    Dim CRef As Workbook, wkb As Workbook
    Dim shtDATE As Worksheet, shtJOB As Worksheet, sht As Worksheet
    Dim aDate As Date, fYR As Date
    Dim fYear As Variant
    Dim rng As Range, rngJOBS As Range, rngJBGRP As Range
    Dim SC As Long, lastRow As Long, PD As Long, WK As Long

    ' Application.ScreenUpdating = False
    myPath = Application.ActiveWorkbook.Path
'
' Get the file date and assign to variables
'
    Range("D3").Select
    **Selection.NumberFormat = "m-d-yyyy"**
    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 = "m-d-yyyy"
    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)
    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
'
    sht.Activate
    Range("A2:A" & lastRow).Value = fYear
    Range("E2:E" & lastRow).Value = PDWK
    Range("G2:G" & lastRow).Value = PD
    Range("H2:H" & lastRow).Value = WK
'
' Close reference file
'
    Application.DisplayAlerts = False
    CRef.Close False
'
' Cleanup, save and close workbooks
'
    Application.DisplayAlerts = False
    wkb.SaveAs fName, 51
'
' SQL call: Load to existing datbase (GDrive), use same format as Transactions
' ?? Get sales by day? vs maintain PDWK - Future
'
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
'    wkb.Close.false



End Sub
Private Function VLookupVBA(what As Variant, lookupRng As Range, defaultValue As Variant) As Variant
    Dim rv As Variant: rv = Application.VLookup(what, lookupRng, lookupRng.Columns.Count, False)
    If IsError(rv) Then
        VLookupVBA = "NULL"
    Else
        VLookupVBA = rv
    End If
End Function

Public Sub UsageExample()
    MsgBox VLookupVBA("ValueToFind", ThisWorkbook.Sheets("ReferenceSheet").Range("A:D"), "Not found!")
End Sub
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

excel - Excel VBA：查找日期范围表中的日期行

问题描述

解决方案

推荐阅读