شمارش همه شخصیت ها در اکسل

Question

وقتی با کاربرگ‌ها کار می‌کنید - به‌ویژه آنهایی که از افراد دیگر هستند - ممکن است به دنبال راهی برای شمارش تعداد کاراکترهای یک کاربرگ باشید. ماکرو زیر در این زمینه بسیار مفید است. تعداد کاراکترهای یک کتاب کار کامل، از جمله نویسه‌های موجود در کادرهای متنی درج‌شده در کاربرگ‌های مختلف را می‌شمارد.

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
         Count characters in text boxes
        For Each shp In wks.Shapes
            If TypeName(shp) <> "GroupObject" Then
                lTxtBox = lTxtBox + shp.TextFrame.Characters.Count
            End If
        Next shp

         Count characters in cells containing constants
        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

         Count characters in cells containing formulas
        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") & _
      " Characters in text boxes" & vbCrLf
    sMsg = sMsg & Format(lConstants, "#,##0") & _
      " Characters in constants" & vbCrLf & vbCrLf

    lTotal = lTxtBox + lConstants

    sMsg = sMsg & Format(lTotal, "#,##0") & _
      " Total characters (as constants)" & vbCrLf & vbCrLf

    sMsg = sMsg & Format(lFormulaValues, "#,##0") & _
      " Characters in formulas (as values)" & vbCrLf
    sMsg = sMsg & Format(lFormulas, "#,##0") & _
      " Characters in formulas (as formulas)" & vbCrLf & vbCrLf

    lTotal2 = lTotal + lFormulas
    lTotal = lTotal + lFormulaValues

    sMsg = sMsg & Format(lTotal, "#,##0") & _
      " Total characters (with formulas as values)" & vbCrLf
    sMsg = sMsg & Format(lTotal2, "#,##0") & _
      " Total characters (with formulas as formulas)"

    MsgBox Prompt:=sMsg, Title:="Character count"

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

ماکرو ممکن است بسیار طولانی به نظر برسد، اما دقیقاً در آنچه انجام می دهد، ساختار بسیار خوبی دارد. ابتدا، تمام کادرهای متن یک کاربرگ را بررسی می کند. اگر آنها گروه بندی نشده باشند (شما نمی توانید کاراکترها را در کادرهای متنی گروه بندی شده بشمارید)، کاراکترهای موجود در آنها با هم جمع می شوند. سپس ماکرو کاراکترها را در سلول های حاوی ثابت جمع می کند. در نهایت، تمام کاراکترهای استفاده شده در سلول های حاوی فرمول را شمارش می کند. تعادل ماکرو برای ارائه اطلاعات در یک جعبه پیام استفاده می شود.