在每个单元格 Excel 中使用 VBA 而不是使用公式（索引和匹配）

Question

正如您在“数据”表上看到的，我有这样的数据表（请参见下文）

我想要的输出是这样的：

目前在输出表中，

1. 我必须为每个月手动添加 YYYYMM 每一列

2. 对于列的每个月，我必须输入公式来获取订单数量。 公式是这样的：

   =IFNA(INDEX(Data!C:C,(MATCH(A3&$B$2,Data!D:D,0))),"")
   

代码可以给我每个月的订单数量。

但是，我想做的是每月生成并使用 VBA 获取订单数量。

Answer 1

这是一个使用变体数组来收集结果的示例，所以会很快。

假设您已经预先构建了结果表项目和编号标题

Sub Demo()
    'Call FillTable with parameters
    ' Top Left Cell of Source Data range, including headers
    ' Top Left Cell of Destination Table range, including headers
    ' Column to match in Source
    ' Column to return from Source
    FillTable Worksheets("Data").Range("A1"), Worksheets("Final").Range("A2"), 4, 3
End Sub

Sub FillTable(rSrc As Range, rTable As Range, MatchCol As Long, QtyCol As Long)
    Dim vSrc As Variant, vTable As Variant
    Dim Items As Variant, Dates As Variant
    Dim rw As Long, cl As Long


    Set rSrc = Range(rSrc.Offset(1, 0), rSrc.End(xlDown)).Resize(, Application.Max(MatchCol, QtyCol))
    Set rTable = Range(rTable.End(xlToRight).Offset(1, 0), rTable.End(xlDown).Offset(0, 1))

    vSrc = rSrc.Value2
    vTable = rTable.Value2

    Items = rTable.Columns(0).Value2
    Dates = rTable.Rows(0).Value2

    For cl = 1 To UBound(vTable, 2)
    For rw = 1 To UBound(vTable, 1)
        With Application
            vTable(rw, cl) = .IfNa(.Index(rSrc.Columns(QtyCol), .Match(Items(rw, 1) & Dates(1, cl), rSrc.Columns(MatchCol), 0)), vbNullString)
        End With
    Next rw, cl

    rTable = vTable
End Sub

Answer 2

Sub FillData()

For Each cell In Worksheets("Data").Columns(2).Cells

    If cell.Value = "" Then Exit Sub    'stop program if no value
    If WorksheetFunction.IsText(cell.Value) = True Then GoTo line1  'do not perform action if YYYYMM

    Set FindMth = Worksheets("Final").Rows(2).Find(cell.Value)  'Find Month at Final Sheet
    Set FindItem = Worksheets("Final").Columns(1).Find(cell.Offset(0, -1).Value, lookat:=xlWhole)   'Find Item Number at Final Sheet

    If Not FindMth Is Nothing Then
        C = FindMth.Column  'Column Month
    Else        
        If Worksheets("Final").Range("B2").Value <> "" Then
            Worksheets("Final").Range("A2").End(xlToRight).Offset(0, 1).Value = cell.Value
            C = Worksheets("Final").Range("A2").End(xlToRight).Column   'Column Month if B2 not empty
        Else
            Worksheets("Final").Range("B2").Value = cell.Value
            C = 2
        End If
    End If

    If Not FindItem Is Nothing Then
        R = FindItem.Row    'Row Item Number
    Else
        Worksheets("Final").Range("A1").End(xlDown).Offset(1).Value = cell.Offset(0, -1).Value
        R = Worksheets("Final").Range("A1").End(xlDown).Row
    End If

    Worksheets("Final").Cells(R, C).Value = cell.Offset(0, 1).Value 'Assign Order Qty
    Worksheets("Final").Range("B1:" & Cells(1, C).Address).Merge    'Merge YYYYMM cell

line1:
Next

End Sub