在每个单元格Excel中使用VBA而不是使用公式(INDEX& MATCH)

时间:2018-06-06 02:35:22

标签: excel vba excel-vba

正如您在"数据"表,我有这样的数据表(请参见下文)

Data Sheet

我想要的输出是这样的:

Output Sheet

目前在输出表中,

  1. 我必须每个月为每个列手动添加YYYYMM
  2. 对于该列的每个月,我必须输入公式才能获得订单数量。 公式是这样的:

    =IFNA(INDEX(Data!C:C,(MATCH(A3&$B$2,Data!D:D,0))),"")
    
  3. 代码可以给我每个月的订单数量。

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

2 个答案:

答案 0 :(得分:1)

这是一个使用变量Array收集结果的示例,因此将是Fast。

假设您已预先构建了结果表项和数字标题

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

答案 1 :(得分:0)

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