VBA循环遍历2个不同大小的范围

Question

甚至不确定它是否可能或它背后的逻辑（上周才开始使用 VBA），但我需要帮助来循环遍历两个不同大小但具有相似 ID 的不同范围。

在一张纸上，我有大约 1500 行，大约 700 个唯一 ID，在第二张纸上，我有 650 行，都是唯一的。我现在遇到的问题是，它会遍历 650 行，但由于第一行中有额外的唯一 ID，我的长度大约为 100。

到目前为止，我的代码如下，可能还有其他一些问题，或者我正在做的事情可能会导致不同的问题，但仍在学习，因此我们将不胜感激。

哦，我可以通过将 compare3 改回 Sheet2!R2C1:R700C1 来让它工作，但我希望我能用尽可能少的设定值让它工作。

ATM，我遇到了一个错误

 Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"

因为比较 3 范围的唯一值比比较要少。

Function compare(FieldName As String, FieldName1 As String, FieldName2 As String) As Boolean

Dim wkb As Workbook
Dim ws, ws1 As Worksheet
Dim lRow As Long, lRow1, lRow2 As Long
Dim aCell As Range, rng1 As Range, aCell1 As Range, rng2 As Range, aCell2 As Range, aCell3 As Range
encrypt = True
Dim x As Integer
x = 2
Dim comparison As String
Dim comparison1 As Integer
Dim comparison2 As String
Dim comparison3 As String
Dim comparison4 As Integer
Dim y As Integer
Dim aCellComparison, aCellComparison1, aCellComparison2 As Range
Dim a As Integer
a = 2

 Set wkb = ActiveWorkbook

 With wkb

    Set ws = ActiveSheet
    Set ws1 = wkb.Sheets("Sheet2")

    '~~> Find the cell which has the name
 Set aCell = ws.Range("A1:Z1").Find(FieldName, LookAt:=xlWhole)
 Set aCell1 = ws.Range("A1:Z1").Find(FieldName1, LookAt:=xlWhole)
 Set aCell2 = ws.Range("A1:Z1").Find("HOS_PROC_FIXED_COST", LookAt:=xlWhole)
 Set aCell3 = ws.Range("A1:Z1").Find(FieldName2, LookAt:=xlWhole)
 Set aCellComparison = ws1.Range("A1:Z1").Find("Code", LookAt:=xlWhole)
 Set aCellComparison1 = ws1.Range("A1:Z1").Find("LOS", LookAt:=xlWhole)

  If aCell Is Nothing Then
        compare = False
  End If

  If Not aCell Is Nothing Then
  lRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) &    ws.Rows.Count).End(xlUp).Row
 lRow1 = ws.Range(Split(ws.Cells(, aCell1.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow2 = ws.Range(Split(ws.Cells(, aCell2.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row



 Set rng1 = ws.Range(ws.Cells(x, aCell.Column), ws.Cells(lRow, aCell.Column))
 Set rng2 = ws1.Range(ws1.Cells(x, aCellComparison.Column), ws1.Cells(lRow,  aCellComparison.Column))
 If lRow And lRow1 And lRow2 > 1 Then
            '~~> Set your Range


    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    y = aCell2.Column
 For Each c In rng1

        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
        comparison3 = ws1.Cells(a, aCellComparison.Column).Value
        comparison4 = ws1.Cells(a, aCellComparison.Column).Value

        Range("J" & x).Select
        Application.CutCopyMode = False


        If ((x > 2) And (comparison <> ws.Cells(x - 1, aCell.Column).Value)) Then
            a = a + 1
        End If

    If comparison2 = "1" Then

     Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"

    ElseIf comparison2 = "2" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=    Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),3)"
    ElseIf comparison2 = "3" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=  Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),4)"
    ElseIf comparison2 = "6" Then
    Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "=       Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),5)"
    End If

    x = x + 1
Next



End If
End If
End With
End Function

Answer 1

我可以建议您使用 Scripting.Dictionary 对象吗？在您的 VBA IDE 中，转到菜单 Tools->References 并从可用的参考中检查标记为 Microsoft Scripting Runtime 的库。然后你可以编写如下代码来比较两组代码

Sub T()


    Dim dicFirst As Scripting.Dictionary
    Set dicFirst = New Scripting.Dictionary

    'loop adding numbers from first set
    Dim v
    For Each v In Range("FirstIDs").Cells
        dicFirst.Add v, Empty
    Next v


    Dim dicSecond As Scripting.Dictionary
    Set dicSecond = New Scripting.Dictionary

    'loop adding numbers from second set
    For Each v In Range("SecondIDs").Cells
        dicSecond.Add v, Empty
    Next v

    'to find all ids in first but not second...
    For Each v In dicFirst.Keys
        If Not dicSecond.Exists(v) Then
            Debug.Print v & " in 1 but not 2"
        End If
    Next v

    'to find all ids in second but not first ...
    For Each v In dicSecond.Keys
        If Not dicFirst.Exists(v) Then
            Debug.Print v & " in 2 but not 1"
        End If
    Next v

End Sub

Answer 2

我自己现在就开始工作了。以防万一其他人将来需要它。代码如下。

Function compare(FieldName As String, FieldName1 As String, FieldName2 As String) As Boolean

Dim wkb As Workbook
Dim ws, ws1 As Worksheet
Dim lRow As Long, lRow1, lRow2 As Long
Dim aCell As Range, rng1 As Range, aCell1 As Range, rng2 As Range, aCell2 As Range, aCell3 As Range
encrypt = True
Dim aCellUnique As Range
Dim x As Integer
x = 1
Dim comparison As String
Dim comparison1 As Integer
Dim comparison2 As String
Dim comparison3 As String
Dim comparison4 As Integer
Dim y As Integer
Dim aCellComparison, aCellComparison1, aCellComparison2 As Range
Dim a As Integer
a = 2

Set wkb = ActiveWorkbook

With wkb

    Set ws = ActiveSheet
    Set ws1 = wkb.Sheets("Sheet2")

    '~~> Find the cell which has the name
Set aCell = ws.Range("A1:Z1").Find(FieldName, LookAt:=xlWhole)
Set aCell1 = ws.Range("A1:Z1").Find(FieldName1, LookAt:=xlWhole)
Set aCell2 = ws.Range("A1:Z1").Find("HOS_PROC_FIXED_COST", LookAt:=xlWhole)
Set aCell3 = ws.Range("A1:Z1").Find(FieldName2, LookAt:=xlWhole)
Set aCellComparison = ws1.Range("A1:Z1").Find("Code", LookAt:=xlWhole)
Set aCellComparison1 = ws1.Range("A1:Z1").Find("LOS", LookAt:=xlWhole)


If aCell Is Nothing Then
        compare = False
 End If

 If Not aCell Is Nothing Then
 lRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow1 = ws.Range(Split(ws.Cells(, aCell1.Column).Address, "$")(1) & ws.Rows.Count).End(xlUp).Row
 lRow2 = ws1.Range(Split(ws1.Cells(, aCellComparison.Column).Address, "$")(1) & ws1.Rows.Count).End(xlUp).Row



 Set rng1 = ws.Range(ws.Cells(x, aCell.Column), ws.Cells(lRow, aCell.Column))
 Set rng2 = ws1.Range(ws1.Cells(x, aCellComparison.Column), ws1.Cells(lRow2,  aCellComparison.Column))
 If lRow And lRow1 And lRow2 > 1 Then
            '~~> Set your Range


    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    y = aCell2.Column

 For Each c In rng1

        x = x + 1
        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
        comparison3 = ws1.Cells(a, aCellComparison.Column).Value
        comparison4 = ws1.Cells(a, aCellComparison1.Column).Value

        If ((x > 2) And (comparison <> comparison3)) Then

                a = a + 1
                comparison3 = ws1.Cells(a, aCellComparison.Column).Value
                comparison4 = ws1.Cells(a, aCellComparison1.Column).Value

        End If



  If comparison <> comparison3 Then
    Do Until comparison = comparison3
        x = x + 1
        comparison = ws.Cells(x, aCell.Column).Value
        comparison1 = ws.Cells(x, aCell1.Column).Value
        comparison2 = ws.Cells(x, aCell3.Column).Value
    Loop

        End If





        Range("J" & x).Select
        Application.CutCopyMode = False


    If comparison2 = "1" Then

     Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & " = " & comparison3 & ")*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),2)"

    ElseIf comparison2 = "2" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),3)"
    ElseIf comparison2 = "3" Then
        Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),4)"
    ElseIf comparison2 = "6" Then
    Selection.FormulaArray = _
            "=INDEX(Sheet2!R2C1:R700C7,MATCH(1,(" & comparison & "= Sheet2!R2C1:R700C1)*(" & comparison1 & "= Sheet2!R2C7:R700C7),0),5)"
    End If

Next



 End If
 End If 
 End With
 End Function