Como Optimizar macros en excel ...
Hoy les traigo una consulta un poco más extensa, cree un formulario en el cual hay varias macros, el formulario en si anda bien, pero me gustaría que ande mejor, entonces les quería preguntar si me pueden ayudar con esta pequeña macro, ya que la hice con mis pocos conocimientos y seguramente se puede optimizar muchísimo.
1 Respuesta
H o l a:
Veo bastante bien tu macro. Solamente le hice unos pequeños ajustes:
Sheets("DGR").Select
filalibre = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Set midato = ActiveSheet.Range("B1:B" & filalibre).Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If midato Is Nothing Then
Sheets("DeudaDgr").Select
fila = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(fila, 1).Value = "No Posee"
Cells(fila, 2).Value = "Registros"
Else
Fil = midato.Row
For a = 4 To Range("A1").End(xlToRight).Column
periodo = Format(Cells(1, a).Value, "mmmm/yyyy")
Monto = Cells(Fil, a).Value
fdePago = Empty
NºdeRecibo = Empty
If Cells(Fil, a).Comment Is Nothing Then
fdePago = "No presentado"
Else
texto = Cells(Fil, a).Comment.Text
Posicion = InStr(1, texto, "_")
If Posicion = 0 Then
fdePago = Cells(Fil, a).Comment.Text
NºdeRecibo = Empty
Else
fdePago = Left(texto, InStr(texto, "_") - 1)
NºdeRecibo = Mid(texto, InStr(texto, "_") + 1)
End If
End If
'carga las variables
Sheets("DeudaDGR").Select
fila = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(fila, 1).Value = periodo
If IsNumeric(Monto) Then
Cells(fila, 2).Value = CDbl(Monto)
Else
Cells(fila, 2).Value = Monto
End If
If IsDate(fdePago) = True Then
Cells(fila, 3).Value = CDate(fdePago)
Else
Cells(fila, 3).Value = fdePago
End If
Cells(fila, 4).Value = NºdeRecibo
Sheets("DGR").Select
Next a
End IfResumen:
- En las variables fdePago y NºdeRecibo tienes "emtpy" y debe ser Empty
- Quité la variable Columnalibre, no es necesaria
- Quité el With y el End With, tampoco es muy necesario.
- Quité la variable Ubica, ya que en el objeto midato, tienes las propiedades de la celda encontrada, como su address y como su Row, es por eso que la fila la puedes obtener directamente de midato. Row
Otra mejora que podrías hacerle, es que en lugar de cambiarte de una hoja a otra; puedas utilizar las hojas como objeto, la macro se ejecuta más rápido. Entonces solamente haces referencia al objeto, en cada Range y en cada Cells.
Quedaría de esta forma:
filalibre = Application.WorksheetFunction.CountA(h1.Range("A:A")) + 1
Set midato = h1.Range("B1:B" & filalibre).Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If midato Is Nothing Then
fila = Application.WorksheetFunction.CountA(h2.Range("A:A")) + 1
h2.Cells(fila, 1).Value = "No Posee"
h2.Cells(fila, 2).Value = "Registros"
Else
Fil = midato.Row
For a = 4 To h1.Range("A1").End(xlToRight).Column
periodo = Format(h1.Cells(1, a).Value, "mmmm/yyyy")
Monto = h1.Cells(Fil, a).Value
fdePago = Empty
NºdeRecibo = Empty
If h1.Cells(Fil, a).Comment Is Nothing Then
fdePago = "No presentado"
Else
texto = h1.Cells(Fil, a).Comment.Text
Posicion = InStr(1, texto, "_")
If Posicion = 0 Then
fdePago = h1.Cells(Fil, a).Comment.Text
NºdeRecibo = Empty
Else
fdePago = Left(texto, InStr(texto, "_") - 1)
NºdeRecibo = Mid(texto, InStr(texto, "_") + 1)
End If
End If
'carga las variables
fila = Application.WorksheetFunction.CountA(h2.Range("A:A")) + 1
h2.Cells(fila, 1).Value = periodo
If IsNumeric(Monto) Then
h2.Cells(fila, 2).Value = CDbl(Monto)
Else
h2.Cells(fila, 2).Value = Monto
End If
If IsDate(fdePago) = True Then
h2.Cells(fila, 3).Value = CDate(fdePago)
Else
h2.Cells(fila, 3).Value = fdePago
End If
h2.Cells(fila, 4).Value = NºdeRecibo
Next a
End If
Si te sirvieron las recomendaciones, recuerda valorar. Sal u dos
Excelente dante, como siempre!
Intente hacer eso de configurar
h2.Cells(fila, 2).Value = Monto
Pero mi error era que ponia "Range(Cells(fila,2)).Value", pensando que era necesario, y me tiraba error!...muchas gracias voy a probar de esta forma y voy a ir adaptando el resto de las macros que basicamente son similares.
Cualquier cosa vuelvo a preguntar...muchisimas gracias
Perdona, no copié completa la macro, faltaron las declaraciones de los objetos de las hojas set h1 y set h2:
Set h1 = Sheets("DGR")
Set h2 = Sheets("DeudaDgr")
'
filalibre = Application.WorksheetFunction.CountA(h1.Range("A:A")) + 1
Set midato = h1.Range("B1:B" & filalibre).Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If midato Is Nothing Then
fila = Application.WorksheetFunction.CountA(h2.Range("A:A")) + 1
h2.Cells(fila, 1).Value = "No Posee"
h2.Cells(fila, 2).Value = "Registros"
Else
Fil = midato.Row
For a = 4 To h1.Range("A1").End(xlToRight).Column
periodo = Format(h1.Cells(1, a).Value, "mmmm/yyyy")
Monto = h1.Cells(Fil, a).Value
fdePago = Empty
NºdeRecibo = Empty
If h1.Cells(Fil, a).Comment Is Nothing Then
fdePago = "No presentado"
Else
texto = h1.Cells(Fil, a).Comment.Text
Posicion = InStr(1, texto, "_")
If Posicion = 0 Then
fdePago = h1.Cells(Fil, a).Comment.Text
NºdeRecibo = Empty
Else
fdePago = Left(texto, InStr(texto, "_") - 1)
NºdeRecibo = Mid(texto, InStr(texto, "_") + 1)
End If
End If
'carga las variables
fila = Application.WorksheetFunction.CountA(h2.Range("A:A")) + 1
h2.Cells(fila, 1).Value = periodo
If IsNumeric(Monto) Then
h2.Cells(fila, 2).Value = CDbl(Monto)
Else
h2.Cells(fila, 2).Value = Monto
End If
If IsDate(fdePago) = True Then
h2.Cells(fila, 3).Value = CDate(fdePago)
Else
h2.Cells(fila, 3).Value = fdePago
End If
h2.Cells(fila, 4).Value = NºdeRecibo
Next a
End If
