¡Realmente necesito tu ayuda con este asunto, por favor!
No tengo ningún error, todo funciona sin problemas....
Todo lo que necesito es que, excepto hacer coincidir 1 con 1 columna, necesito hacer coincidir 2 con 2 columnas.
La columna A en la hoja de origen a la columna G en la hoja de destino (ya aquí) Quiero agregar también a esa columna B en la hoja de origen a la columna H en la hoja de destino.
Resumen: haga coincidir 2 columnas en la hoja de origen (A y B) con 2 columnas en la hoja de destino (G y H).
Espero que hayas entendido mi pregunta. ¡gracias!
Primera parte del código: sin problemas
Sub Get_Data()
Const NUM_DATA_COLS As Long = 4
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Set SourceSheet = GetWorkbook(Source).Worksheets("Data")
Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")
Dim SourceLastRow As Long, TargetLastRow As Long
SourceLastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
TargetLastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim Primary_Fields(1 To NUM_DATA_COLS), Foreign_Fields(1 To NUM_DATA_COLS), n As Long
Dim i As Long, v, m
Dim rngPrimary_Key As Range
Dim Foreign_Key As Variant
Segunda parte del código:
Cómo agregar otro (rngPrimary_Key2) y (Foreign_Key2) para hacer coincidir 2 columnas con 2 columnas
Solo estoy haciendo coincidir esos
Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow) Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value
Necesito agregarlos a los criterios coincidentes
Set rngPrimary_Key2 = SourceSheet.Range("B2:B" & SourceLastRow)
Foreign_Key2 = TargetSheet.Range("H2:H" & TargetLastRow).Value
^- si estas dos columnas coinciden en ambas hojas, guárdelas en una matriz en lugar de hacer coincidir solo una columna.
Set rngPrimary_Key = SourceSheet.Range("A2:A" & SourceLastRow)
Foreign_Key = TargetSheet.Range("G2:G" & TargetLastRow).Value
For n = 1 To NUM_DATA_COLS
Primary_Fields(n) = SourceSheet.Range("B2:B" & SourceLastRow).Offset(0, n - 1).Value
Foreign_Fields(n) = EmptyCopy(Foreign_Key) 'empty array for results
Next n
' get matching rows and copy values to arrays
For i = LBound(Foreign_Key, 1) To UBound(Foreign_Key, 1)
v = Foreign_Key(i, 1)
m = Application.Match(v, rngPrimary_Key, 0)
If Not IsError(m) Then 'check got a match
For n = 1 To NUM_DATA_COLS
Foreign_Fields(n)(i, 1) = Primary_Fields(n)(m, 1)
Next n
End If
Next i
' / Write (Keys-IndexMatch) in Range offset Foreign_Field_1 2
Place2DArray TargetSheet.Range("H2"), Foreign_Fields(1)
Place2DArray TargetSheet.Range("i2"), Foreign_Fields(2)
Place2DArray TargetSheet.Range("J2"), Foreign_Fields(3)
Place2DArray TargetSheet.Range("K2"), Foreign_Fields(4)
End Sub
Resto del código, no relacionado con mi pregunta.
'return an empty array of same dimensions as 'arr'
Function EmptyCopy(arr)
Dim rv
ReDim rv(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2))
EmptyCopy = rv
End Function
'copy a 1-based 2-d array 'arr' to a worksheet, starting at cell 'c'
Sub Place2DArray(c As Range, arr)
c.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub