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

Respuesta
3

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 Sub

Pero 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 Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas