variable - Acelerar el trabajo con comentarios en Excel VBA

refrescar hoja excel vba

Question

Este es un ejemplo que ideé, lo creé para explicar el problema que estoy teniendo. Básicamente, quiero que este código se ejecute más rápido de lo que lo hace. En una hoja nueva, cada ciclo de una celda comienza rápido, pero si lo deja casi al final y luego lo vuelve a ejecutar, alcanzará los 100 ms por celda. En mi hoja tengo 16000 celdas con muchos comentarios como este, y se manipulan de forma individual cada vez que se ejecuta el código. En este ejemplo, obviamente son todos iguales, pero en la aplicación real cada uno es diferente.

¿Hay alguna forma de hacer este proceso más rápido?

Option Explicit
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long
Public Sub BreakTheCommentSystem()
Dim i As Integer
Dim t As Long
Dim Cell As Range
Dim dR As Range
Set dR = Range(Cells(2, 1), Cells(4000, 8))

Dim rStr As String
rStr = "ABCDEFG HIJK LMNOP QRS TUV WX YZ" & Chr(10)

For i = 1 To 5
    rStr = rStr & rStr
Next i

For Each Cell In dR
    t = GetTickCount
    With Cell
        If .Comment Is Nothing Then
            .AddComment
        Else
            With .Comment
                With .Shape.TextFrame.Characters.Font
                    .Bold = True
                    .Name = "Arial"
                    .Size = 8
                End With
                .Shape.TextFrame.AutoSize = True
                .Text rStr
            End With
        End If

    End With
    Debug.Print (GetTickCount - t & " ms ")
Next

rStr = Empty
i = Empty
t = Empty
Set Cell = Nothing
Set dR = Nothing


End Sub

Actualización 12-11-2015, quería que esto se anotara en algún lugar en caso de que alguien se topara con él, la razón por la que intentaba optimizar esto era porque VSTO no me dejaba agregar un archivo de libro de trabajo con todos estos comentarios. Después de 6 meses de trabajar con Microsoft, ahora se trata de un error confirmado en VSTO y Excel.

https://connect.microsoft.com/VisualStudio/feedback/details/1610713/vsto-hangs-while-editing-an-excel-macro-enabled-workbook-xlsm-file

Answer 1

Al desactivar la actualización de la pantalla, pude reducir el tiempo de cada iteración de alrededor de 100 ms a alrededor de 17 ms. Puede agregar lo siguiente al comienzo del procedimiento:

Application.ScreenUpdating = False

Puede volver a activar la actualización al final del procedimiento volviendo a establecerla en verdadero.

Answer 2

Creo que encontré 2 formas de mejorar el rendimiento de tu tarea

1. El código en su ejemplo se ejecuta durante un promedio de 25 minutos, lo bajé a 4.5 minutos:

   • Crea una nueva hoja
   • Copie y pegue todos los valores de la hoja inicial
   • Copie todos los comentarios en una matriz bidimensional (dirección de la celda y texto de comentario)
   • Genera los mismos comentarios para las mismas celdas en la nueva hoja, con el nuevo formato

2. Este es bastante simple de implementar y probar, y es muy específico para su caso

   • A partir de la descripción, está procesando los mismos comentarios una y otra vez
   • La parte más cara es cambiar la fuente
   • Con este ajuste, solo actualizará la fuente para los nuevos comentarios (los existentes ya están usando la fuente del procesamiento anterior, incluso si el texto se actualiza)

Intente actualizar esta parte del código en el archivo real (no es tan efectivo para el ejemplo)

With .Shape.TextFrame
    With .Characters.Font
        If Not .Bold Then .Bold = True
        If .Name <> "Arial" Then .Name = "Arial"
        If .Size <> 8 Then .Size = 8
    End With
    If Not .AutoSize Then .AutoSize = True
End With

o:

With .Shape.TextFrame
    With .Characters.Font
        If Not .Bold Then
            .Bold = True
            .Name = "Arial"
            .Size = 8
        End If
    End With
    If Not .AutoSize Then .AutoSize = True
End With

Avíseme si está interesado en la otra opción y puedo proporcionar la implementación

Answer 3

Desactive la actualización de la pantalla y, si no necesita workboook para volver a calcular durante la macro, ajustar el cálculo a manual realmente reducirá el tiempo. Esto evitará que todas las fórmulas de su libro de trabajo se procesen cada vez que modifique una celda. Estas dos funciones me permiten contrastar informes bastante grandes en cuestión de segundos.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 

Por supuesto, al final de la macro, configúrelos nuevamente como verdaderos y automáticos

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Answer 4

Este código copia los datos en una nueva hoja de cálculo y recrea todas las notas:

En un nuevo módulo de usuario:

Option Explicit

Private Const MAX_C     As Long = 4000
Private Const MAIN_WS   As String = "Sheet1"
Private Const MAIN_RNG  As String = "A2:H" & MAX_C
Private Const MAIN_CMT  As String = "ABCDEFG HIJK LMNOP QRS TUV WX YZ"

Public Sub BreakTheCommentSystem_CopyPasteAndFormat()
    Dim t As Double, wsName As String, oldUsedRng As Range
    Dim oldWs As Worksheet, newWs As Worksheet, arr() As String

    t = Timer
    Set oldWs = Worksheets(MAIN_WS)
    wsName = oldWs.Name
UpdateDisplay False
    RemoveComments oldWs
    MakeComments oldWs.Range(MAIN_RNG)
    Set oldUsedRng = oldWs.UsedRange.Cells
    Set newWs = Sheets.Add(After:=oldWs)
    oldUsedRng.Copy
    With newWs.Cells
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormulasAndNumberFormats
        .Cells(1, 1).Copy
        .Cells(1, 1).Select
    End With
    arr = GetCommentArrayFromSheet(oldWs)
    RemoveSheet oldWs
    CreateAndFormatComments newWs, arr
    newWs.Name = wsName
UpdateDisplay True
    InputBox "Duration: ", "Duration", Timer - t
    ''272.4296875 (4.5 min), 269.6796875, Excel 2007: 406.83203125 (6.8 min)
End Sub

.

Otras funciones:

Public Sub UpdateDisplay(ByVal state As Boolean)
    With Application
        .Visible = state
        .ScreenUpdating = state
        ''.VBE.MainWindow.Visible = state
    End With
End Sub

Public Sub RemoveSheet(ByRef ws As Worksheet)
    With Application
        .DisplayAlerts = False
        ws.Delete
        .DisplayAlerts = True
    End With
End Sub

''---------------------------------------------------------------------------------------

Public Sub MakeComments(ByRef rng As Range)
    Dim t As Double, i As Long, cel As Range, txt As String
    txt = MAIN_CMT & Chr(10)
    For i = 1 To 5
        txt = txt & txt
    Next
    For Each cel In rng
        With cel
            If .Comment Is Nothing Then .AddComment txt
        End With
    Next
End Sub

Public Sub RemoveComments(ByRef ws As Worksheet)
    Dim cmt As Comment
    ''For Each cmt In ws.Comments
    ''    cmt.Delete
    ''Next
    ws.UsedRange.ClearComments
End Sub

''---------------------------------------------------------------------------------------

Public Function GetCommentArrayFromSheet(ByRef ws As Worksheet) As String()
    Dim arr() As String, max As Long, i As Long, cmt As Comment
    If Not ws Is Nothing Then
        max = ws.Comments.Count
        If max > 0 Then
            ReDim arr(1 To max, 1 To 2)
            i = 1
            For Each cmt In ws.Comments
                With cmt
                    arr(i, 1) = .Parent.Address
                    arr(i, 2) = .Text
                End With
                i = i + 1
            Next
        End If
    End If
    GetCommentArrayFromSheet = arr
End Function

Public Sub CreateAndFormatComments(ByRef ws As Worksheet, ByRef commentArr() As String)
    Dim i As Long, max As Long
    max = UBound(commentArr)
    If max > 0 Then
        On Error GoTo restoreDisplay
        For i = 1 To max
            With ws.Range(commentArr(i, 1))
                .AddComment commentArr(i, 2)
                With .Comment.Shape.TextFrame
                    With .Characters.Font
                        If .Bold Then .Bold = False                     ''True
                        If .Name <> "Calibri" Then .Name = "Calibri"    ''"Arial"
                        If .Size <> 9 Then .Size = 9                    ''8
                        If .ColorIndex <> 9 Then .ColorIndex = 9
                    End With
                    If Not .AutoSize Then .AutoSize = True
                End With
                DoEvents
            End With
        Next
    End If
    Exit Sub
restoreDisplay:
    UpdateDisplay True
    Exit Sub
End Sub

Espero que esto ayude

Answer 5

Según la recopilación de comentarios de MSDN y la documentación del objeto Comentario , puede hacer referencia a todos los comentarios dentro de una hoja de cálculo a través de su posición indexada y tratarlos directamente en lugar de recorrer cada celda y determinar si contiene un comentario.

Dim c As Long
With ActiveSheet    ''<- set this worksheet reference properly!
    For c = 1 To .Comments.Count
        With .Comments(c)
            Debug.Print .Parent.Address(0, 0)  '' the .parent is the cell containing the comment
            '' do stuff with the .Comment object
        End With
    Next c
End With

También de acuerdo con los documentos oficiales para el método Range.SpecialCells , puede determinar fácilmente un subconjunto de celdas en una hoja de cálculo utilizando la constante xlCellTypeComments como el parámetro Tipo .

Dim comcel As Range
With ActiveSheet    ''<- set this worksheet reference properly!
    For Each comcel In .Cells.SpecialCells(xlCellTypeComments)
        With comcel.Comment
            Debug.Print .Parent.Address(0, 0)  '' the .parent is the cell containing the comment
            '' do stuff with the .Comment object
        End With
    Next comcel
End With

Todavía no tengo claro el razonamiento detrás de llenar todas las celdas no comentadas con un comentario en blanco, pero si intenta trabajar con los comentarios solo en una hoja de trabajo, es mejor trabajar con el subconjunto de celdas comentadas en lugar de recorrer todas las celdas buscando un comentario.