Macro que sume de acuerdo al primer dígito
Muy buenos días:
Estoy en busca de una macro, "No Fórmula de excel", que realice suma de acuerdo al primer dígito como se ve en la ilustración, lo que esta resaltado en color seria el resultado de la macro.
¿Esto se puede?
1 respuesta
Con la siguiente macro resuelves el ejemplo que pusiste.
Sub SumaPrimerDigito()
'Por.Dante Amor
Range("D17:E19").ClearContents
For i = 4 To 15
Select Case Left(Cells(i, "C"), 1)
Case "1"
Cells(17, "D") = Cells(17, "D") + Cells(i, "D")
Cells(17, "E") = Cells(17, "E") + Cells(i, "E")
Case "2"
Cells(18, "D") = Cells(18, "D") + Cells(i, "D")
Cells(18, "E") = Cells(18, "E") + Cells(i, "E")
Case "3"
Cells(19, "D") = Cells(19, "D") + Cells(i, "D")
Cells(19, "E") = Cells(19, "E") + Cells(i, "E")
End Select
Next
End SubPero no indicaste si tienes más periodos o si tienes más de 3 dígitos o si vas a tener más datos después de la fila 15. Si el caso es que vas a tener más de todo, preparo una nueva macro y te la envío.
Perdón por olvidarme de eso Dante, si la verdad, son más periodos el numero de periodos son variables, puede ser uno o 15, los dígitos siempre van a comenzar por 1, por 2, por 3, por 4, por 5, por 6, y por 7, y por ultimo siempre van a haber muchas más filas, pueden ser 300 filas como 500 filas.
Gracias Amigo!.
Utiliza esta macro. La información deberá estar como la pusiste en el ejemplo, es decir, los números deben empezar en la celda C4 y los valores en la D4, los títulos de los periodos en la fila 3.
Sub SumaPrimerDigito()
'Por.Dante Amor
Application.ScreenUpdating = False
u = Range("C4").End(xlDown).Row
u2 = Range("D" & Rows.Count).End(xlUp).Row
If u2 = u Then u2 = u2 + 1
uc = Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(u + 1, "A"), Cells(u2, uc)).ClearContents
Rows(3).Copy Rows(u + 2)
Cells(u + 2, "C") = "Dígito"
'
For i = 4 To u
n = Val(Left(Cells(i, "C"), 1))
u2 = Range("C" & Rows.Count).End(xlUp).Row
If u2 < u Then u2 = u
Set b = Range("C" & u + 1 & ":C" & u2).Find(n, lookat:=xlWhole)
If Not b Is Nothing Then
For j = 4 To uc
Cells(b.Row, j) = Cells(b.Row, j) + Cells(i, j)
Next
Else
u2 = Range("C" & Rows.Count).End(xlUp).Row + 1
If u2 < u Then u2 = u + 3
Cells(u2, "A") = "Suma de los números que comienzan por:"
Cells(u2, "C") = n
For j = 4 To uc
Cells(u2, j) = Cells(u2, j) + Cells(i, j)
Next
End If
Next
Application.ScreenUpdating = True
MsgBox "Suma terminada"
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
