VBA Looping a través de 2 ranges de diferentes tamaños

Ni siquiera estoy seguro de si es posible o de la lógica subyacente (solo comenzó VBA la semana pasada), pero necesito ayuda para recorrer dos ranges diferentes que son de diferentes tamaños pero con ID similares.

En una hoja tengo alnetworkingedor de 1500 filas y alnetworkingedor de 700 identificadores únicos, y en la segunda hoja tengo 650 filas, todas únicas. El problema que tengo es que en este momento, recorrerá las 650 filas, pero estoy cerca de 100 debido a las ID únicas adicionales en la primera fila.

El código que tengo hasta ahora está debajo, probablemente algunas otras cosas malas con él, o estoy haciendo cosas que podrían causar diferentes problemas, pero aún estoy aprendiendo, así que cualquier ayuda sería apreciada.

Oh, puedo hacerlo funcionar cambiando la comparación3 de nuevo a Sheet2! R2C1: R700C1, pero espero que pueda hacerlo funcionar con la menor cantidad de valores configurados posible.

Causa, estoy recibiendo un error en

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

como el range de comparación 3 tiene less valores únicos que pasar que la comparación.

 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 

¿Puedo sugerirle que use un object Scripting.Dictionary? En su IDE de VBA, vaya al menu Herramientas-> Referencias y desde la reference disponible, marque la biblioteca marcada como Microsoft Scripting Runtime. Luego puede escribir código como el siguiente que compara dos sets de códigos

 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 

Lo tengo trabajando ahora mismo. Solo en caso de que alguien más lo necesite en el futuro. El código está abajo.

 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