VBA实用小程序71：统计工作簿中的字符数

excelperfect

引言：这是在ozgrid.com论坛中看到的一个VBA程序，特辑录于此，供有兴趣的朋友学习参考。

下面的程序统计工作簿中所有工作表的字符总数，包括其中的文本框中的字符数。

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

        '统计文本框中的字符

        For Each shp In wks.Shapes

            If TypeName(shp) <>'GroupObject' Then

                lTxtBox = lTxtBox +shp.TextFrame.Characters.Count

            End If

        Next shp

        '统计包含常量的单元格中的字符

        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

        '统计包含公式的单元格的字符

        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')& _

            ' 个字符' &vbCrLf

    sMsg = sMsg & '常量中有 ' &Format(lConstants, '#,##0') & _

            ' 个字符' &vbCrLf & vbCrLf

    lTotal = lTxtBox + lConstants

    sMsg = sMsg & Format(lTotal,'#,##0') & _

            ' 个字符 (作为常量)' &vbCrLf & vbCrLf

    sMsg = sMsg & '在公式中(作为值)有 ' &Format(lFormulaValues, '#,##0') & _

            ' 个字符' &vbCrLf

    sMsg = sMsg & '在公式中(作为公式)有 ' &Format(lFormulas, '#,##0') & _

            ' 个字符' &vbCrLf & vbCrLf

    lTotal2 = lTotal + lFormulas

    lTotal = lTotal + lFormulaValues

    sMsg = sMsg & '(公式作为值)有 ' &Format(lTotal, '#,##0') & _

            ' 个字符' &vbCrLf

    sMsg = sMsg & '(公式作为公式)有 ' &Format(lTotal2, '#,##0') & _

            ' 个字符'

    MsgBox Prompt:=sMsg, Title:='字符统计'

ExitHandler:

    Application.ScreenUpdating = True

    Exit Sub

ErrHandler:

    If bPossibleError And Err.Number = 1004Then

        bPossibleError = False

        bSkipMe = True

        Resume Next

    Else

        MsgBox Err.Number & ': '& Err.Description

        Resume ExitHandler

    End If

End Sub

对于下面的示例工作簿，运行CountCharacters过程后的结果如下图1所示。

图1

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料。