Question

我知道需要一个匹配函数来向左查找值而不是向右查找值（VLOOKUP）。

我想点击宏按钮显示前两列的项目（如果单元格（超过截止日期）），并构建一个超过截止日期的项目数组。

Sub ItemRegister()
    Application.Workbooks("Current.xlsm").Worksheets("Sheet1").Activate
On Error GoTo MyErrorHandler:
Dim Today As Date
Dim InspectionDate As Range
Dim ItemRow As Long
Dim ItemCol As Long
Dim Check As Variant
Today = Date
Set InspectionDate = [G4:G500]
Set TableC = [A4:A500]
Set TableS = [B4:B500]
Set DateArray = [G4:G500]
ItemRow = [G4].Row
ItemCol = [G4].Column
For Each Cell In InspectionDate
    Check = Application.Match(Cell, DateArray, 0) 'need to fix match up
If Cell = "" Then
    Item = ""
    Serial = ""
    If Cell <= Today Then
        Item = Application.WorksheetFunction.Index(TableC, Check)
        Serial = Application.WorksheetFunction.Index(TableS, Check)
        Else
            Item = ""
            Serial = ""
    End If
    ItemRow = ItemRow + 1
End If
Next Cell
Exit Sub
MyErrorHandler:
If Err.Number = 1004 Then
    MsgBox "An error has occured - please ensure that cells have not been altered in anyway - Something is wrong with code, Debug It" 'Remove this, when process is completed
Else
MsgBox "The item(s) that need inspection is/are: " & vbNewLine & vbNewLine & Item & "-" & Serial
End If
End Sub

提前致谢。

Answer 1

你可以采用AutoFilter()方法;

Option Explicit

Sub main()
    Dim area As Range
    Dim iCell As Long

    With Application.Workbooks("Current.xlsm").Worksheets("Sheet1") '<--| reference relevant worksheeu
        With .Range("G3", .Cells(.Rows.COUNT, "G").End(xlUp).Offset(1)) '<-- reference its column "G" cell from row 3 down to last not empty cell
            .AutoFilter Field:=1, Criteria1:="<=" & CDbl(Date) '<--| filter referenced column on dates preceeding or equal today's date
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell filtered other than header (which is in row 3)
                With .SpecialCells(xlCellTypeVisible) '<--| reference columnn "G" filtered cells
                    ReDim Item(1 To .COUNT) '<--| size Item array to the number of referenced (i.e. filtered) cells
                    ReDim Serial(1 To .COUNT) '<--| size Serial array to the number of referenced (i.e. filtered) cells
                    For Each cell In .Cells '<--| loop through referenced (i.e. filtered) cells
                        iCell = iCell + 1 '<--| update cell counter
                        Item(iCell) = cell.Offset(, -6).Value '<--| retrieve value in column "A" cell at current filtered cell row
                        Serial(iCell) = cell.Offset(, -5).Value '<--| retrieve value in column "G" cell at current filtered cell row
                    Next cell
                End With
            End If
        End With
        .AutoFilterMode = False '<--| show all rows back
    End With
End Sub

基于比较日期循环遍历列，如果小于今天，则查找以前的列

1 个答案: