Buenas Tardes, 

Alguien me podria apoyar con resumir las operaciones ya que desarrolle las operaciones en un rango de filas por ejemplo hasta 45, sin embargo muchas hojas son variables y la formula a veces es mas de 45 hasta 100 o 200 filas, por lo que se demora un poco en las operaciones, habra alguna forma de que las operaciones se hagan en funcion de la cantidad de datos de determinada columna

SAludos,

 

Sub ProcesarMO()
Dim celda As Object
Dim rng As Range

Set rng = Range("I13:FE13")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G13")) * Val(Range("H13")) / 9.5
  
  Next celda
  
  Set rng = Range("I14:FE14")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G14")) * Val(Range("H14")) / 9.5
  Next celda
  
  Set rng = Range("I15:FE15")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G15")) * Val(Range("H15")) / 9.5
  Next celda

Set rng = Range("I16:FE16")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G16")) * Val(Range("H16")) / 9.5
  Next celda
  
Set rng = Range("I17:FE17")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G17")) * Val(Range("H17")) / 9.5
  Next celda

Set rng = Range("I18:FE18")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G18")) * Val(Range("H18")) / 9.5
  Next celda

Set rng = Range("I19:FE19")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G19")) * Val(Range("H19")) / 9.5
  Next celda

Set rng = Range("I20:FE20")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G20")) * Val(Range("H20")) / 9.5
  Next celda

Set rng = Range("I21:FE21")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G21")) * Val(Range("H21")) / 9.5
  Next celda
Set rng = Range("I22:FE22")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G22")) * Val(Range("H22")) / 9.5
  Next celda
Set rng = Range("I23:FE23")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G23")) * Val(Range("H23")) / 9.5
  Next celda
Set rng = Range("I24:FE24")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G24")) * Val(Range("H24")) / 9.5
  Next celda

Set rng = Range("I25:FE25")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G25")) * Val(Range("H25")) / 9.5
  Next celda
Set rng = Range("I26:FE26")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G26")) * Val(Range("H26")) / 9.5
  Next celda

Set rng = Range("I27:FE27")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G27")) * Val(Range("H27")) / 9.5
  Next celda

Set rng = Range("I28:FE28")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G28")) * Val(Range("H28")) / 9.5
  Next celda

Set rng = Range("I29:FE29")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G29")) * Val(Range("H29")) / 9.5
  Next celda

Set rng = Range("I30:FE30")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G30")) * Val(Range("H30")) / 9.5
  Next celda

Set rng = Range("I31:FE31")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G31")) * Val(Range("H31")) / 9.5
  Next celda

Set rng = Range("I32:FE32")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G32")) * Val(Range("H32")) / 9.5
  Next celda

Set rng = Range("I33:FE33")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G33")) * Val(Range("H33")) / 9.5
  Next celda

Set rng = Range("I34:FE34")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G34")) * Val(Range("H34")) / 9.5
  Next celda

Set rng = Range("I35:FE35")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G35")) * Val(Range("H35")) / 9.5
  Next celda

Set rng = Range("I36:FE36")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G36")) * Val(Range("H36")) / 9.5
  Next celda
Set rng = Range("I37:FE37")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G37")) * Val(Range("H37")) / 9.5
  Next celda

Set rng = Range("I38:FE38")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G38")) * Val(Range("H38")) / 9.5
  Next celda

Set rng = Range("I39:FE39")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G39")) * Val(Range("H39")) / 9.5
  Next celda
Set rng = Range("I40:FE40")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G40")) * Val(Range("H40")) / 9.5
  Next celda

Set rng = Range("I41:FE41")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G41")) * Val(Range("H41")) / 9.5
  Next celda

Set rng = Range("I42:FE42")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G42")) * Val(Range("H42")) / 9.5
  Next celda

Set rng = Range("I43:FE43")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G43")) * Val(Range("H43")) / 9.5
  Next celda

Set rng = Range("I44:FE44")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G44")) * Val(Range("H44")) / 9.5
  Next celda

Set rng = Range("I45:FE45")

For Each celda In rng
valor = celda.Value
  If valor Like "*S*" Then celda = Val(Range("G45")) * Val(Range("H45")) / 9.5
  Next celda
  
''''''
Application.ScreenUpdating = True
MsgBox "Calculo de M.O Exitoso", vbInformation
Exit Sub

End Sub
 

Estimados Espero su ayuda,

Adjunto Archivo en el cual tengo las dos macros para resumir codigos y corregir gráfica

Saludos

Archivo de grafica y like en consulta.xlsm

Sustituye tu código por este:

Sub ProcesarMO(): Application.ScreenUpdating = False
    Dim celda As Object
    Dim uf, uc As Long
    
    uf = Hoja8.Range("D" & Rows.Count).End(xlUp).Row
    uc = Hoja8.Cells(9, Columns.Count).End(xlToLeft).Column
    For Each celda In Range("I13:ED" & uf)
        If celda Like "*S*" Then celda = CDbl(Cells(celda.Row, 7) * Cells(celda.Row, ) / 9.5)
    Next celda
    
    For cont = 9 To uc
        Hoja8.Cells(12, cont) = Application.WorksheetFunction.Sum(Hoja8.Range(Hoja8.Cells(13, cont), Hoja8.Cells(uf, cont)))
    Next cont
    MsgBox "Calculo de M.O Exitoso", vbInformation

End Sub

 

Editado el el 7 de junio5 años por JSDJSD

Usando a estructura With/End With se puede simplificar el código pero te lo pongo así para mayor comprensión. Si quieres utilizarlo en otras hojas simplemente modifica donde pone Hoja8 por la Hoja en la que quieras aplicarlo.

Ojo¡¡¡  Hoja8 se refiere al nombre interno de la hoja.

 

Hola JSDJSD,

Gracias por tu ayuda, esta genial se redujo un monton, 

Saludos,

 

Me alegro mucho, pero nunca olvides agradecer a quien te ayuda o intenta ayudar y en el foro la manera de agradecer es mediante el corazoncillo que tenemos en la parte inferior derecha.