Contare tutti i caratteri presenti in una cartella di lavoro

Quando lavori con cartelle di lavoro, in particolare quelli di altre persone, potresti cercare un modo per contare il numero di caratteri presenti in un foglio di lavoro. La seguente macro è molto utile a questo proposito. Conta il numero di caratteri in un’intera cartella di lavoro, inclusi eventuali caratteri in eventuali caselle di testo inserite nei vari fogli di lavoro.

 

Sub CountCharacters()
    Dim wks As Worksheet
    Dim rng As Range
    Dim rCell As Range
    Dim shp As Shape

    Dim bPossibleError As Boolean
    Dim bSkipMe As Boolean

    Dim lTotal As Long
    Dim lTotal2 As Long
    Dim lConstants As Long
    Dim lFormulas As Long
    Dim lFormulaValues As Long
    Dim lTxtBox As Long
    Dim sMsg As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    lTotal = 0
    lTotal2 = 0
    lConstants = 0
    lFormulas = 0
    lFormulaValues = 0
    lTxtBox = 0
    bPossibleError = False
    bSkipMe = False
    sMsg = ""

    For Each wks In ActiveWorkbook.Worksheets
        ' Conta i caratteri nelle caselle di testo
        For Each shp In wks.Shapes
            If TypeName(shp) <> "GroupObject" Then
                lTxtBox = lTxtBox + shp.TextFrame.Characters.Count
            End If
        Next shp

        ' Conta i caratteri nelle celle contenenti costanti
        bPossibleError = True
        Set rng = wks.UsedRange.SpecialCells(xlCellTypeConstants)
        If bSkipMe Then
            bSkipMe = False
        Else
            For Each rCell In rng
                lConstants = lConstants + Len(rCell.Value)
            Next rCell
        End If

        ' Conta i caratteri nelle celle contenenti formule
        bPossibleError = True
        Set rng = wks.UsedRange.SpecialCells(xlCellTypeFormulas)
        If bSkipMe Then
            bSkipMe = False
        Else
            For Each rCell In rng
                lFormulaValues = lFormulaValues + Len(rCell.Value)
                lFormulas = lFormulas + Len(rCell.Formula)
            Next rCell
        End If
    Next wks

    sMsg = Format(lTxtBox, "#,##0") & _
      " Caratteri in caselle di testo" & vbCrLf
    sMsg = sMsg & Format(lConstants, "#,##0") & _
      " Caratteri in costanti" & vbCrLf & vbCrLf

    lTotal = lTxtBox + lConstants

    sMsg = sMsg & Format(lTotal, "#,##0") & _
      " Caratteri totali (come costanti)" & vbCrLf & vbCrLf

    sMsg = sMsg & Format(lFormulaValues, "#,##0") & _
      " Caratteri in formule (come valori)" & vbCrLf
    sMsg = sMsg & Format(lFormulas, "#,##0") & _
      " Caratteri in formule (come formule)" & vbCrLf & vbCrLf

    lTotal2 = lTotal + lFormulas
    lTotal = lTotal + lFormulaValues

    sMsg = sMsg & Format(lTotal, "#,##0") & _
      " Caratteri totali (con formule come valori)" & vbCrLf
    sMsg = sMsg & Format(lTotal2, "#,##0") & _
      " Caratteri totali (con formule come formule)"

    MsgBox Prompt:=sMsg, Title:="Conteggio caratteri"

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    If bPossibleError And Err.Number = 1004 Then
        bPossibleError = False
        bSkipMe = True
        Resume Next
    Else
        MsgBox Err.Number & ": " & Err.Description
        Resume ExitHandler
    End If
End Sub

 

 

La macro può sembrare piuttosto lunga, ma è molto ben strutturata in quello che fa. Innanzitutto, esamina tutte le caselle di testo in un foglio di lavoro. Se non sono raggruppate (non è possibile contare i caratteri nelle caselle di testo raggruppate), i caratteri in esse contenuti vengono conteggiati. Quindi la macro calcola i caratteri nelle celle contenenti costanti. Infine, conta tutti i caratteri utilizzati nelle celle contenenti formule. Il resto della macro viene utilizzato per presentare le informazioni in una finestra di messaggio.

 

 

Tags: , , , , , , , , , , , , , , , , , , , , , , ,

Ti è stato utile?