excel - 如何添加第三个范围以进行协调？

Question

我正在寻找一个工具来协调 3 个电子表格中的值。例如，Sheet1：ID = 123A，国家 = 爱尔兰；表 2：ID = 123A，国家 = 英国；表 3：ID = 123A，国家 = 英国。如果不匹配，我们将得到一个 FALSE 值。

目前，我有能力在 shtRecon 的 B 和 C 列中协调 2 个文件，并希望在 D 列中添加第三个值，这将协调 3 个文件而不是 2 个文件。

换句话说，当B列=C列时，有0个错误，当B列<>C列时，有1个错误。我希望它是 B 列 = C 列 = D 列。我在下面包含了用于 2 列对帐的工作代码。有任何想法吗？

Sub ReconcileVenueRef()
                                           
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim shtRecon As Worksheet
    Dim shtSummary As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel As Range
    Dim oDict As Object
    Dim reconRow As Long
    Dim noOfErrors As Long
    Dim ETL As Variant
    Dim MiFID As Variant
    Dim Match As Boolean
    
    Set sht1 = Worksheets("MiFID Export")
    Set sht2 = Worksheets("ETL")
    Set shtRecon = Worksheets("Reconciliation")
    Set shtSummary = Worksheets("Summary")

    'Define the columns that you need, and find the last row
    Set rng1 = sht1.Range("A2:B" & sht1.Range("A" & sht1.Rows.Count).End(xlUp).Row)
    Set rng2 = sht2.Range("A2:B" & sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row)
    
    'Get a dictionary object holding unique values from sheet 2
    'In my case, column A holds the Id, and column B holds the value
    Set oDict = GetDictionary(rng2, 1, 4)
    
    reconRow = 0
    
    'Loop over each cel in sheet 1, column 1
    'Look for the value in column 1 in the sheet 2 dictionary
    'object, and then reconcile
    For Each cel In Intersect(rng1, sht1.Columns(1))
        'Get the next avail row in reconciliation sheet
        reconRow = reconRow + 1
        shtRecon.Range("A" & reconRow).Value = cel.Value
        
        'Recon column B holds value from sheet 1, column B
        shtRecon.Range("B" & reconRow).Value = cel.Offset(, 3).Value
        
        
        'If Id is found in Sheet B dictionary, then take the value
        'otherwise, write "blank" in column C
        'ETL spreadsheet
        If oDict.exists(cel.Value) Then
            shtRecon.Range("C" & reconRow).Value = oDict(cel.Value)
        Else
            shtRecon.Range("C" & reconRow).Value = "BLANK"
        End If
    Next cel
    

   'If ETL cell = MiFID cell then noOfErrors is 0, otherwise it's 1
    noOfErrors = 0
    
    ETL = shtRecon.Cells(1, 3).Value
    MiFID = shtRecon.Cells(1, 2).Value
    
    If ETL = MiFID Then
    Match = True
    shtRecon.Cells(1, 4).Value = Match
    shtSummary.Cells(4, 3).Value = noOfErrors

    ElseIf ETL <> MiFID Then
    Match = False
    shtRecon.Cells(1, 4).Value = Match
    noOfErrors = noOfErrors + 1
    shtSummary.Cells(4, 3).Value = noOfErrors

    End If
    
    End Sub





    'Function stores a range into a dictionary
    'Param inputRange takes a range to be stored
    'Param idColumn takes the column of the range to be used as the ID
    'e.g. if idColumn = 2, and inputRange("C1:F10"), then column D is used for ID
    'Param valueColumn points to the column in range used for the value
    Function GetDictionary(inputRange As Range, idColumn As Long, valueColumn As Long) As Object
        Dim oDict As Object
        Dim sht As Worksheet
        Dim cel As Range
        
        Set oDict = CreateObject("Scripting.Dictionary")
        Set sht = inputRange.Parent
        
        For Each cel In Intersect(inputRange, inputRange.Columns(idColumn))
            If Not oDict.exists(cel.Value) Then
                oDict.Add cel.Value, sht.Cells(cel.Row, valueColumn).Value
            End If
        Next cel
        
        Set GetDictionary = oDict
    End Function

标签： excelvbafunctiondictionary