比较不同工作表中的值（VBA/公式）

Question

我有两张 Excel 表格，一张是累积的（年初至今），一张是定期的（季度）。我正在尝试检查潜在的输入错误。

简化的 ytd 表：

ID      Q1/18       Q2/18        Q3/18      Q4/18      Q1/19     Q2/19     ...
1        6           12            20        28        10        20       
2        5           11            18        26        10        20       
3        5           11            18        26        10        20

简化的季度表：

ID     Q1/18       Q2/18        Q3/18      Q4/18      Q1/19     Q2/19     ...
1        6           6            8          8         10        10       
2        5           6            7          8         10        10       
3        5           6            7          8         10        10       

在上面的例子中没有输入错误。

我正在尝试创建看起来像这样的第三张工作表

ID     Q1/18       Q2/18        Q3/18      Q4/18      Q1/19     Q2/19     ...
1                    T            T          T         T        T       
2                    T            T          T         T        T       
3                    T            T          T         T        T  

我最初尝试使用这样的公式：

 =IF('YTD'!C2-'YTD LC'!B2-'QTR'!B2=0,T,F)

我不是特别喜欢这个，因为这个公式不适用于第一季度。这也假设我在两张表中的数据以相同的方式排序。虽然我相信它在所有情况下都是正确的，但我宁愿有类似索引匹配的东西来确认。

我尝试根据我在此处找到的其他解决方案开发 VBA 解决方案，但进展不如通过公式：

Sub Compare()

lrow = Cells (Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xltoLeft).Column

Sheets.Add
ActiveSheet.Name = "Temp Sheet"

For i = 2 To lrow
    For j = 3 To lcol

    valytd = Worksheets("YTD").Cells(i,j).Value
    valytd = Worksheets("YTD").Cells(i,j).Value

    If valytd = valytd Then
        Worksheets("Temp").Cells(i,j).Value = "T"
    Else:                           
        Worksheets("Temp").Cells(i,j).Value = "F"
        Worksheets("Temp").Cells(i,j).Interior.Color Index = 40

    End If
    Next j
 Next i
 End Sub

Answer 1

在我看来，最简单的方法是：

1. 创建工作表并复制粘贴第 1 行 + 第 1 列，如下图所示（标题和 ID）
2. 使用 Sum Product 得到答案

公式：

=IF(SUMPRODUCT((Sheet1!$B$1:$G$1=Sheet3!$B$1)*(Sheet1!$A$2:$A$4=Sheet3!A2)*(Sheet1!$B$2:$G$4))=SUMPRODUCT((Sheet2!$B$1:$G$1=Sheet3!$B$1)*(Sheet2!$A$2:$A$4=Sheet3!A2)*(Sheet2!$B$2:$G$4)),"T","F")

公式说明：

• 使用双 $$ -> Sheet1!$B$1:$G$1 继续修复 Quarters 的范围
• 使用双 $$ -> Sheet1!$A$2:$A$4 继续使用 ID 修复范围
• 用值保持固定范围 -> Sheet1!$B$2:$G$
• 保持修正列标题 -> =Sheet3!$B$1
• 保留可变行数 -> =Sheet3!A2

图片：

Answer 2

这应该可以解决问题，代码都被注释了：

Option Explicit
Sub Compare()

    Dim arrYTD As Variant, arrQuarterly As Variant, arrResult As Variant
    Dim Compare As Scripting.Dictionary 'You need Microsoft Scripting Runtime for this to work
    Dim i As Long, j As Integer, x As Integer

    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    With ThisWorkbook
        arrYTD = .Sheets("Name of YTD sheet").UsedRange.Value 'this will get everything on that sheet
        arrQuarterly = .Sheets("Name of Quarterly sheet").UsedRange.Value 'this will get everything on that sheet
    End With
    ReDim arrResult(1 To UBound(arrYTD), 1 To UBound(arrYTD, 2)) 'resize the final array with the same size of YTD

    Set Compare = New Scripting.Dictionary

    'Here we fill the dictionary with the ID's position on the arrQuarterly array
    For i = 2 To UBound(arrQuarterly) '2 because 1 is headers
        If Not Compare.Exists(arrQuarterly(i, 1)) Then 'this is an error handle if you have duplicated ID's
            Compare.Add arrQuarterly(i, 1), i 'now we know the position of that ID on the table
        Else
            'Your handle if there was a duplicated ID
        End If
    Next i

    'Let's fill the headers on the result array
    For i = 1 To UBound(arrYTD, 2)
        arrResult(1, i) = arrYTD(1, i)
    Next i

    'Now let's compare both tables assuming the columns are the same on both tables (same position)
    For i = 1 To UBound(arrYTD)
        arrResult(i, 1) = arrYTD(i, 1) 'This is the ID
        For j = 2 To UBound(arrYTD, 2)
            x = Compare(arrYTD(i, 1)) 'this way we get the position on the quarterly array for that ID
            If arrYTD(i, j) = arrQuarterly(x, j) Then 'compare if they have the same value on both sides
                arrResult(i, j) = "T"
            Else
                arrResult(i, j) = "F"
            End If
        Next j
    Next i

    With ThisWorkbook.Sheets("Name of the result sheet") 'paste the array to it's sheet
        .Range("A1", .Cells(UBound(arrResult), UBound(arrResult, 2))).Value = arrResult
    End With

End Sub