VBA Looping через 2 диапазона различного размера

Question

Даже не уверен, что это возможно или логика позади него (только на прошлой неделе была запущена VBA), но мне нужна помощь в переходе через два разных диапазона, которые имеют разные размеры, но с похожими идентификаторами.

На одном листе у меня около 1500 строк и около 700 уникальных идентификаторов, а на втором листе у меня 650 строк, все уникальные. Проблема в том, что я на данный момент, она будет проходить через 650 строк, но я около 100 коротких из-за дополнительных уникальных идентификаторов в первой строке.

Код, который я до сих пор находится ниже, возможно, несколько других вещей с ним не так, или я делаю то, что может вызвать различные проблемы, но все же учиться, поэтому любая помощь будет оценена.

О, я могу заставить его работать, меняя сравнение3 назад на Sheet2! R2C1: R700C1, но я надеюсь, что смогу заставить его работать с минимальными установленными значениями.

Банкоматы, я получаю сообщение об ошибке на

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 перейдите в меню «Инструменты» -> «Ссылки» и из доступной справки проверьте библиотеку с надписью «Время выполнения сценариев Microsoft». Затем вы можете написать код, например, следующий, который сравнивает два набора кода:

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