如何计算excel文件中的所有字符?

问题描述 投票:1回答:4

我使用的是我在这里找到的脚本:https://excelribbon.tips.net/T008349_Counting_All_Characters.html

它正在按预期工作,但是当有一些其他对象(如图片)时,脚本会返回错误438“对象不支持此属性或方法”。当我删除图片时,脚本再次运行良好。

是否有选项可以在脚本中添加“忽略图片”?或者是否有更好的脚本来实现这一目标?我对VBA一点都不擅长,所有的帮助将不胜感激。

excel vba
4个回答
1
投票

这是一种可能会更好的简化方法。我认为明确哪些形状类型你想要计算它将是一个更清洁的方式来解决这个问题。

Option Explicit

Private Function GetCharacterCount() As Long
    Dim wks          As Worksheet
    Dim rng          As Range
    Dim cell         As Range
    Dim shp          As Shape

    For Each wks In ThisWorkbook.Worksheets
        For Each shp In wks.Shapes
            'I'd only add the controls I care about here, take a look at the Shape Type options
            If shp.Type = msoTextBox Then GetCharacterCount = GetCharacterCount + shp.TextFrame.Characters.Count
        Next

        On Error Resume Next
        Set rng = Union(wks.UsedRange.SpecialCells(xlCellTypeConstants), wks.UsedRange.SpecialCells(xlCellTypeFormulas))
        On Error GoTo 0

        If not rng Is Nothing Then
            For Each cell In rng
                GetCharacterCount = GetCharacterCount + Len(cell.Value)
            Next
        end if
    Next
End Function

Sub CountCharacters()
   Debug.Print GetCharacterCount()
End Sub

0
投票

看起来你可以在这里添加if-check(VBA Code to exclude images png and gif when saving attachments为“PNG”和“GIF”)。

您只需更改if-check以检查您正在使用“JPG”或“JPEG”的图片类型?只需将扩展名与if-check匹配,将“PNG”或“GIF”替换为CAPS中的扩展名即可。

在错误发生的上方添加if-check,或者更好,将其添加到发生错误的范围之上。


0
投票

我从你的链接中获取了脚本并进行了修改。现在它有效。 它远非完美(在某些情况下它仍然可以崩溃),但现在它支持处理没有Shapes属性的.TextFrame

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
                On Error GoTo nextShape
                lTxtBox = lTxtBox + shp.TextFrame.Characters.Count
            End If
nextShape:
        Next shp

        On Error GoTo ErrHandler
        ' 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

0
投票

你可以尝试:

Option Explicit

Sub test()

    Dim NoOfChar As Long
    Dim rng As Range, cell As Range

    NoOfChar = 0

    For Each cell In ThisWorkbook.Worksheets("Sheet1").UsedRange '<- Loop all cell in sheet1 used range

        NoOfChar = NoOfChar + Len(cell.Value) '<- Add cell len to NoOfChar

    Next cell

    Debug.Print NoOfChar

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.