比較日に基づいて列をルーピングし、今日よりも前の列を検索する

Question

右（VLOOKUP）ではなく左に値をルックアップするにはマッチ関数が必要であることを理解します。

セルが期日を過ぎている場合、マクロボタンをクリックして前の2つの列の項目を表示し、期日を過ぎた項目の配列を作成したいとします。

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