Блог

У меня есть два листа Excel, один накопительный (с начала года) и один периодический (ежеквартальный). Я пытаюсь проверить наличие потенциальных ошибок ввода.

Упрощенная таблица с начала года:

 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
  

На мой взгляд, самый простой способ — это:

1. Создайте лист и скопируйте строку 1 столбец 1, как показано на рисунке ниже (заголовок и идентификаторы)
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")
  

Примечания к формулам:

• Продолжайте исправлять диапазон с помощью четвертей, используя double $$ -> Sheet1!$B $ 1:$ G $ 1
• продолжайте исправлять диапазон идентификаторами, используя double $$ -> Sheet1!$A$2:$ A$ 4
• Продолжайте фиксировать диапазон значениями -> Лист1!$B $2: $ G $
• Продолжайте исправлять заголовок столбца -> = Лист3!$ B $ 1
• Оставьте число строк переменной -> = Лист3!A2

Изображения:

Это должно сработать, весь код прокомментирован:

 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