すべての文字を数える（Microsoft Excel）

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