基于来自两个不同工作表的多个标准连接和求和单元格

Question

Image of WorkSheet1Image of WorkSheet2 如果我想根据两个不同工作表中的标准对一列中的单元格求和并连接另一列中的单元格，Excel VBA 代码会是什么样子？在下面的示例中，我想根据以下条件汇总费率并连接 WorkSheet1 中的类型：

1. 如果 WorkSheet1 中的描述与 WorkSheet2 中的描述匹配

2. 如果 WorkSheet2 中的代码是 03

3. 如果 WorkSheet1 中的类型是“收入”和“特殊现金”

这是 VBA 代码运行之前工作表的样子：

工作表1

        Column A        Column B               Column C
(Row 1) Description     Type                   Rate 
(Row 2) BGIO US Equity  Income                 0.05    
(Row 3) BGIO US Equity  Short Term Cap Gain    0.009573
(Row 4) BGIO US Equity  Special Cash           0.00931

工作表2

        Column A         Column B    Column C
(Row 1) Description      Rate        Code  
(Row 2) BGIO US Equity   0.05931     03
(Row 3) BGIO US Equity   0.009573    07

这是 VBA 代码运行后 WorkSheet1 中的结果：

        Column A       Column B               Column C
(Row 1) Description    Type                   Rate 
(Row 2) BGIO US Equity Income + Special Cash  0.05931 
(Row 3) BGIO US Equity Short Term Cap Gain    0.009573

本质上，我是在两个工作表之间创建匹配项（如果存在）以进行协调。

这是我目前拥有的 VBA 代码，它不适用于连接部分：

For e = 2 To WorkSheet1LastRow
    checkValue = WorkSheet1.Cells(e, 1)
    For x = 2 To WorkSheet1LastRow
        Type = WorkSheet1.Cells(x, 2)
    Next x
Next e
For c = 2 To WorkSheet2LastRow
    CheckValue2 = WorkSheet2.cells(c, 1)
    For q = 2 To WorkSheet2LastRow
        If WorkSheet2.cells(q, 3) = "03" And WorkSheet2.Cells(q, 1) <> CheckValue2 Then
            If checkValue2 = CheckValue1 Then
                If Type = "Income" Or "Special Cash" Then
                    Type = Type & "+" & Type
                End If
            End If
        End If
    Next q
Next c

我在想如果我能成功编码这部分，我可以记录一个 sumif 公式来完成这个过程。

Answer 1

这似乎与您所描述的一样。

Option Explicit

Sub incomeSpecialCash()
    Dim i As Long, j As Long
    Dim descRate As Variant

    With Worksheets(2)
        ReDim descRate(1 To Application.CountIf(.Columns("C"), 3), 1 To 2)
        j = LBound(descRate, 1)
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "C").Text = "03" Then
                descRate(j, 1) = .Cells(i, "A").Value2
                descRate(j, 2) = .Cells(i, "B").Value2
                j = j + 1
            End If
        Next i
    End With

    With Worksheets(1)
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            For i = LBound(descRate, 1) To UBound(descRate, 1)
                .AutoFilter field:=1, Criteria1:=descRate(i, 1)
                .AutoFilter field:=2, Criteria1:="income"
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        Intersect(.SpecialCells(xlCellTypeVisible), .Columns("C")) = descRate(i, 2)
                        Intersect(.SpecialCells(xlCellTypeVisible), .Columns("B")) = "Income + Special Cash"
                    End If
                End With
                .AutoFilter field:=2, Criteria1:="special cash"
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
                    End If
                End With
            Next i
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub