Macro Sumar (consolidar) distancias Archivo B.xlsx al Archivo A.xlsx
Dam
Se tiene dos archivos : Tabla A.xlsx y Tabla B.xlsx
Tabla A.xlsx
Contenido:
A B C F : Resultado en F ------> Columnas
Codigo desde hasta suma distancias (consolidado)
Codigo 1 5 7 3090,516895
Codigo 1 8 13 6192,198568
Codigo 2 4 8 4000
............
Código N: nregistros o filas
Tabla B.xlsx : donde se encuentran las distancias que se deben sumar según codigo y colocar la suma/resultado en la Tabla A.xlsx en la columna F
Contenido de la Tabla B.xlsx
A B C D: ---------> Columnas
Codigo desde hasta distancia
Codigo 1 0 1 1000
............ ............. ......... ..............
Codigo 1 5 6 1035,59104
Codigo 1 6 7 2054,92586
............ ................ .................... ................
Codigo 2 4 5 1000
Codigo 2 5 6 1000
Codigo 2 6 7 1000
Codigo 2 7 8 1000
N registros o filas
1 respuesta
Prueba lo siguiente:
Los 2 libros A y B, deben estar abiertos.
La información de ambos libros se toma de su primer hoja.
Sub Sumar_Distancias()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim a As Variant, b As Variant, c As Variant
Dim i As Long, j As Long, wSum As Double
'
Set sh1 = Workbooks("A.xlsx").Sheets(1)
Set sh2 = Workbooks("B.xlsx").Sheets(1)
'
a = sh1.Range("A2", sh1.Range("C" & Rows.Count).End(3)).Value2
b = sh2.Range("A2", sh2.Range("D" & Rows.Count).End(3)).Value2
ReDim c(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
wSum = 0
For j = 1 To UBound(b)
If a(i, 1) = b(j, 1) And a(i, 2) <= b(j, 2) And a(i, 3) >= b(j, 2) Then
wSum = wSum + b(j, 4)
End If
Next
c(i, 1) = wSum
Next
sh1.Range("F2").Resize(UBound(a)).Value = c
End Sub
