Question

此程序是使用Excel Visual Basic制作的，应该计算您在A-1单元格中写入的单词中出现的字母的频率。

例如apple - 1x a，1x e，1x l，2x p，其余为0x

Public Sub Test()

    Dim word As String
    Dim wordarr(999) As String
    Dim alph(1 To 29) As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer

    i = 1
    j = 1
    k = 1
    m = 1

    With ThisWorkbook.Worksheets("Tabelle1")
        word = .Cells(1, 1)

    'clearing the columns to rewrite it
        .Columns(3).EntireColumn.Clear
        .Columns(4).EntireColumn.Clear

    'initializing my alphabet array
        alph(1) = "a": alph(2) = "b": alph(3) = "c": alph(4) = "d": alph(5) = "e": alph(6) = "f":
        alph(7) = "g": alph(8) = "h": alph(9) = "i": alph(10) = "j": alph(11) = "k": alph(12) = "l":
        alph(13) = "m": alph(14) = "n": alph(15) = "o": alph(16) = "p": alph(17) = "q": alph(18) = "r":
        alph(19) = "s": alph(20) = "t": alph(21) = "u": alph(22) = "v": alph(23) = "w": alph(24) = "x":
        alph(25) = "y": alph(26) = "z": alph(27) = "_": alph(28) = "-": alph(29) = " "

    'filling up the C column with my alphabet array
        For i = 1 To 29
            .Cells(i, 3) = alph(i)
        Next i

    'converting the string word into an array
        For j = 1 To Len(word)
            wordarr(j) = Mid(word, j, 1)
                If j = Len(word) Then
                    Exit For
                End If
        Next j

    'counting the frequency of each letter in the word and writing it into
    'the column next to it
        For m = 1 To 29
            For k = 1 To Len(word)
                If alph(m) = wordarr(k) Then
                    .Cells(m, 4) = .Cells(m, 4).Value + 1
                End If
            Next k
        Next m
    End With
End Sub

该程序正在运行，但我认为它运行不正常。你对如何优化它有任何建议而不会过度复杂化，我对这种语言很新。还有另一种初始化阵列的方法。我尝试了几种方法，但往往不起作用。

我期待看到你的建议。

Answer 1

这是一个简短而又甜蜜的东西，我相信你很容易就能轻松扩展

Private Sub THIS()
    Dim Char As String, compareString As String, testString As String
    Dim strCount As Long, i As Long, j As Long, y As Long, rCount As Long
    Dim arr(28, 1) As String
    testString = ThisWorkbook.Sheets("Sheet1").Range("a1").Value

    For i = 1 To Len(testString)
        Char = Mid(testString, i, 1)
        For j = 1 To Len(testString)
            For y = LBound(arr, 1) To UBound(arr, 1)
                If Char = arr(y, 0) Then
                    GoTo Nexti
                End If
            Next y
            compareString = Mid(testString, j, 1)
            If Char = compareString Then
                strCount = strCount + 1
            End If
        Next j
        Debug.Print ; Char
        Debug.Print ; strCount
        arr(i, 0) = Char
        arr(i, 1) = strCount
Nexti:
        strCount = 0
    Next i
End Sub

Answer 2

这是另一个

我添加了一个小写转换，以便计算大写字符

还添加了＆＃34; *＆＃34;的计数，仅作为示例

Public Sub Test()

    Dim word As String
    Dim letter As String
    Dim pointer As Integer
    Dim i As Integer

    With ThisWorkbook.Worksheets("Tabelle1")
        word = LCase(.Cells(1, 1))              ' change text to all lower case

        .Columns(3).EntireColumn.Clear          ' clearing the columns to rewrite it
        .Columns(4).EntireColumn.Clear

        For i = 1 To 26                         ' filling up the C column with my alphabet array
            .Cells(i, 3) = Chr(i + 96)          ' chr(97)=="a", chr(122)=="z"
        Next i

        .Cells(27, 3) = "_"                     ' oddballs
        .Cells(28, 3) = "-"
        .Cells(29, 3) = "<space>"
        .Cells(30, 3) = "*"

        For i = 1 To Len(word)                  ' scan text and update cells as you go

            letter = Mid(word, i, 1)

'            If i = Len(word) Then              ' "for .. next" command already does this
'                Exit For
'            End If

            Select Case letter
                Case "a" To "z"
                    pointer = Asc(letter) - 96  ' asc("a")==97, asc("z")==122
                Case "_"
                    pointer = 27
                Case "-"
                    pointer = 28
                Case " "
                    pointer = 29
                Case "*"
                    pointer = 30
                Case Else
                    GoTo skip_cell_update       ' this character is not counted
            End Select
            .Cells(pointer, 4) = .Cells(pointer, 4).Value + 1    ' increment cell

skip_cell_update:
        Next i
    End With
End Sub

计算单词中字母的频率 - 优化

2 个答案: