比较不同工作表(VBA /公式)中的值

时间:2019-03-26 06:56:04

标签: excel vba for-loop

我有两张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

2 个答案:

答案 0 :(得分:0)

这应该可以解决问题,所有代码均已注释:

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

答案 1 :(得分:0)

我认为最简单的方法是:

  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继续用Quarters固定范围!$ B $ 1:$ G $ 1
  • 使用双$$-> Sheet1保持ID固定范围!$ A $ 2:$ A $ 4
  • 使用值保留范围-> Sheet1!$ B $ 2:$ G $
  • 保留修订列标题-> = Sheet3!$ B $ 1
  • 保留可变行号-> = Sheet3!A2

图片:

enter image description here