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

Posted 2023-02-25

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

【英文标题】：Using VBA instead of using formula (INDEX & MATCH) in every cells Excel

【发布时间】：2018-06-06 02:35:22

【问题描述】：

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

我想要的输出是这样的：

目前在输出表中，

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

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

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

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

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

【问题讨论】：

什么版本的 Excel？你不能使用 SUMIFS 吗？

@pnuts 我知道 PivotTable 可以解决它，但我想在 VBA 中完成它，因为这只是我正在尝试编写的子程序。

@Alan，我们不需要使用 SUMIF

您可以在 VBA 中使用工作表函数。例如。 Application.WorksheetFunction.Index 或应用范围内的公式。

【参考方案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

【讨论】：

它运行良好。感谢您的专业建议和编码。

....当前输出是从B列开始的。如果我想从H列开始，我该如何修改代码？请指教。

@java404 更改您调用FillTable 的范围以引用我在答案中定义的单元格

【参考方案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

【讨论】：

程序可以自动填写新的YYYYMM和货号

感谢您的建议。我找到了@Chris

给出的解决方案