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社群,进行技术交流和提问,获取更多电子资料。