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

1 respuesta

Respuesta
2

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 If

Resumen:

  • 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas