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

(0)

相关推荐