Buenas tardes,

vuelvo a escribir para comentaros un problema.

Tengo una petición pro REST API que me trae unos valores, y necesito que calcular el % de cada uno de estos valores, me estoy descargando el total y el valor de cada celda, asi que simplemente seria calcular el procentaje por cada una de las celdas, pero no consigo hacer funcionar el for, si uso formular de excel, me fallan en ocasiones, asi que estoy implementado el uso de una macro.Os pongo lo que estoy intentando y me falla:

 

Sub calcular()
Set rng = Sheets("AAA").Range("G11:G40") ' Rango donde se descargan los valores individuales
Set percent_total = Sheets("AAA").Range("G10")' celda donde esta el total
Set resultado_percent = Sheets("AAA").Range("H10:H11")' celda donde ir poniendo el porcentaje de cada una de las valores del rango G

    For Each cell In rng
    resultado_percent = rng / percent_total
    Next

End Sub
 

Muchas gracias!!!

Prueba con este código:

Sub Porcentaje()

Dim Rango As Range, Celda As Range
Dim Valor As Double
Dim Resultado As Double

Set Rango = Sheet1.Range("G11:G40")
Valor = Sheet1.Range("G10").Value

For Each Celda In Rango
    Resultado = Application.WorksheetFunction.Round(Celda.Value / Valor, 2)
    Celda.Offset(0, 1) = Format(Resultado, "#,##0.00")
Next Celda

End Sub

Si te ha sido de utilidad, un like, y comenta...

A tu macro solo le faltaban algunas lineas, ya agregadas funciona como la pensaste, checala

Sub calcular()
Set Rng = Sheets("AAA").Range("G11:G40") ' Rango donde se descargan los valores individuales
Set percent_total = Sheets("AAA").Range("G10") ' celda donde esta el total
Set resultado_percent = Sheets("AAA").Range("H11:H40") ' celda donde ir poniendo el porcentaje de cada una de las valores del rango G

    a = 1
    For Each cell In Rng
        resultado_percent.Cells(a, 1) = cell / percent_total
    a = a + 1
    Next

With resultado_percent
    .NumberFormat = "0.0%"
    .EntireColumn.AutoFit
End With

End Sub

las dos funciona bien, muchas gracias,

una única cosa, ahora me falta meter que compruebe si tiene un 0, para asi evitar problemas...

 

For Each Celda In Rango
    If Valor = 0 Then
    Rango.Value = Null
    Else
    Resultado = Application.WorksheetFunction.Round(Celda.Value / Valor, 3)
    Celda.Offset(0, 1) = Format(Resultado, "Percent")
    End If
Next Celda

 

estaba metiendo esto pero me da un error....

nada, al final me funciono....

 

For Each Celda In Rango
    If Valor = 0 Then
        Rango.Value = Null
    Else
        Resultado = Application.WorksheetFunction.Round(Celda.Value / Valor, 3)
        Celda.Offset(0, 1) = Format(Resultado, "Percent")
    End If
Next Celda