Сравните значения на разных листах (VBA / формулы) - PullRequest
0 голосов
/ 26 марта 2019

У меня есть два листа 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 голосов
/ 26 марта 2019

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

  1. Создать строку 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")

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

  • Keep fix theдиапазон с четвертями, используя двойной $$ -> Sheet1! $ B $ 1: $ G $ 1
  • , сохраняйте фиксированный диапазон с идентификаторами, используя двойной $$ -> Sheet1! $ A $ 2: $ A $ 4
  • Сохраняйте фиксированный диапазон со значениями -> Sheet1! $ B $ 2: $ G $
  • Сохраняйте заголовок столбца исправлений -> = Sheet3! $ B $ 1
  • Оставляйте переменные номера строк -> = Sheet3! A2

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

enter image description here

0 голосов
/ 26 марта 2019

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

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...