Jump to content

Recommended Posts

Un saludos a todos Uds. les escribo para pedirles su ayuda, tengo 1 archivos Excel con varias columnas y quisiera que los resultados se calculen al pie de cada columnas E,F,I,J .

Y la columna K se calcule con la macro.

Desde ya muchas gracias por su valioso tiempo. 

Adjunto 

Resultados.xlsm

Link to post
Share on other sites

Sustituye tu macro por esta:

Sub Sumar()
Dim fila As Byte
Application.ScreenUpdating = False
With Sheets("STOCK")
   .Range("H3:L7") = ""
   For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row - 1
      fila = 0
      Select Case .Range("B" & I).Interior.Color
         Case Range("H3").Interior.Color: fila = 3
         Case Range("H4").Interior.Color: fila = 4
         Case Range("H5").Interior.Color: fila = 5
         Case Range("H6").Interior.Color: fila = 6
      End Select
      If fila > 0 Then
      
         .Range("I" & fila) = .Range("I" & fila) + .Range("F" & I)
         .Range("I7") = .Range("I7") + .Range("F" & I)
         
         .Range("J" & fila) = .Range("I" & fila) / 2.8
         .Range("J7") = .Range("I7") / 2.8
         
         .Range("L" & fila) = (.Range("L" & fila) + .Range("B" & I) * .Range("F" & I))
         .Range("L7") = (.Range("L7") + .Range("B" & I) * .Range("F" & I))
         
      End If
   Next
   For I = 3 To 7: .Range("K" & I) = .Range("L" & I) / .Range("I" & I):  Next
   .Range("L3:L7") = ""
End With
End Sub

 

Link to post
Share on other sites

Buenas tardes.
Mis agradecimientos por esta solución perfecta.
Seria tan amable que las columnas E,F también se calculen en la ultima fila porque esas columnas se incrementaran, la columna le leyes al ejecutar la macro se borran los textos.
Muchísimas gracias Maestro Antoni Dios lo Bendiga.

 

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now


×
×
  • Create New...

Important Information

Privacy Policy