Macro para sumar valores de varias columnas que correspondan a un mismo valor de otra columna
publicado
Hola tengo esta macro si me funciona pero me pregunto si hay manera de modificarla y no repita las lineas de código ya que necesito que se haga la búsqueda hasta la columna DL
Hola tengo esta macro si me funciona pero me pregunto si hay manera de modificarla y no repita las lineas de código ya que necesito que se haga la búsqueda hasta la columna DL
Tengo una serie de datos mas o menos asi:
A__M__N__DK__DL
1__4__5__2___3
3__6__7__6___1
3__2__6__12__11
4__1__1__4___9
7__3__2__13__32
9__3__5__7___5
9__2__4__3___90
DP_DQ_DR_DS_DT
1__4__9__11_14
3__8__21_39_51
4__1__2__6__15
7__3__5__18_50
9__5__14_24_119
Sub sumarsi()
Application.ScreenUpdating = False
Dim uf As Long, uf2 As Long
Dim rangocriterio As Range
Dim rangosuma1 As Range
Dim rangosuma2 As Range
Dim rangosuma3 As Range
uf = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:A" & uf).AdvancedFilter 2, CriteriaRange, Range("DP1"), Unique:=True 'CAMBIO
Set rangocriterio = Range("A2:A" & uf)
Set rangosuma1 = Range("M2:M" & uf)
Set rangosuma2 = Range("N2:N" & uf)
Set rangosuma3 = Range("O2:O" & uf)
'********************************+
Set rangosuma4 = Range("P2:P" & uf)
Set rangosuma5 = Range("Q2:Q" & uf)
Set rangosuma6 = Range("R2:R" & uf)
Set rangosuma7 = Range("S2:S" & uf)
Set rangosuma8 = Range("T2:T" & uf)
Set rangosuma9 = Range("U2:U" & uf)
Set rangosuma10 = Range("V2:V" & uf)
Set rangosuma11 = Range("W2:W" & uf)
Set rangosuma12 = Range("X2:X" & uf)
Set rangosuma13 = Range("Y2:Y" & uf)
Set rangosuma14 = Range("Z2:Z" & uf)
Set rangosuma15 = Range("AA2:AA" & uf)
Range("DQ1") = Range("M1"): Range("DR1") = Range("N1"): Range("DS1") = Range("O1"): Range("DT1") = Range("P1"): Range("DU1") = Range("Q1"): Range("DV1") = Range("R1")
Range("DW1") = Range("S1"): Range("DX1") = Range("T1"): Range("DY1") = Range("U1"): Range("DZ1") = Range("V1"): Range("EA1") = Range("W1"): Range("EB1") = Range("X1")
'CAMBIOFILA 1
uf2 = Range("DP" & Rows.Count).End(xlUp).Row 'CAMBIO AQUÍ
With Range("DQ2:DQ" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma1.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DR2:DR" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma2.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
'********+PRUEBA D
With Range("DS2:DS" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma3.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
'***********************************************************
With Range("DT2:DT" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma4.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DU2:DU" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma5.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DV2:DV" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma6.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DW2:DW" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma7.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DX2:DX" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma8.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DY2:DY" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma9.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("DZ2:DZ" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma10.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EA2:EA" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma11.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EB2:EB" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma12.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EC2:EC" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma13.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("ED2:ED" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma14.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
With Range("EE2:EE" & uf2) 'CAMBIO AQUÍ
.Formula = "=SUMIF(" & rangocriterio.Address & ", $DP2 ," & rangosuma15.Address & ")" 'CAMBIO AQUÍ
.Formula = .Value
End With
' FIN DE PRUEBA
Set rangocriterio = Nothing
Set rangosuma1 = Nothing
Set rangosuma2 = Nothing
Set rangosuma3 = Nothing
Set rangosuma4 = Nothing
Set rangosuma5 = Nothing
Set rangosuma6 = Nothing
Set rangosuma7 = Nothing
Set rangosuma8 = Nothing
Set rangosuma9 = Nothing
Set rangosuma10 = Nothing
Set rangosuma11 = Nothing
Set rangosuma12 = Nothing
Set rangosuma13 = Nothing
Set rangosuma14 = Nothing
Set rangosuma15 = Nothing
Application.ScreenUpdating = True
End Sub
Gracias por su ayuda
ayuda1.zip