श्रेणी वर्ण गणना

कोड

Sub RangeCharactersCount()

    Const cSheet As String = "Sheet1"   ' Source Worksheet Name
    Const cSrc As String = "A1:A10"     ' Source Column Range
    Const cTgt As String = "B1"         ' Target First Cell Range
    Const c1 As Long = 65               ' First Character Code ("A")
    Const c2 As Long = 90               ' Last Character Code  ("Z")

    Dim vntS As Variant   ' Source Array
    Dim vntT As Variant   ' Target Array
    Dim i As Long         ' Source Array Element Counter, Character Counter
    Dim strB As String    ' Concat String
    Dim LenT As Long      ' Current Length

    ' Copy Source Column Range to Source Array.
    vntS = ThisWorkbook.Worksheets(cSheet).Range(cSrc)
    ' Loop through elements of Source Array.
    For i = 1 To UBound(vntS)
        ' Concatenate Concat String and current element of Source Array.
        strB = strB & vntS(i, 1)
    Next

    ' Resize Target Array to number of characters rows and 2 columns.
    ReDim vntT(1 To c2 - c1 + 1, 1 To 2)

    ' Loop through Characters.
    For i = c1 To c2
        ' Write length of Concat String to Current Length.
        LenT = Len(strB)
        ' Replace all occurrences of current letter with empty string ("").
        strB = Replace(strB, Chr(i), "", , , vbTextCompare)
        ' Write current letter to 1st column of Target Array.
        vntT(i - c1 + 1, 1) = Chr(i)
        ' Write number of occurrences (the difference between Current Length
        ' and the length of Concat String) of current letter to 2nd column of
        ' Target Array.
        vntT(i - c1 + 1, 2) = LenT - Len(strB)
    Next

    With ThisWorkbook.Worksheets(cSheet).Range(cTgt)
        ' Clear contents of Target Range (from Target First Cell Range to
        ' last cell of 2nd column).
        .Resize(.Parent.Rows.Count - .Row + 1, 2).ClearContents
        ' Copy Target Array to Target Range.
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub