將單詞中的字母分類為元音和輔音-有解無憂

給定一個單詞，我需要一個函式以元音和輔音的形式回傳單詞的結構。“c”代表輔音，“v”代表元音。如果字母“y”是單詞的第一個字母，則為輔音，否則視為元音。例如，wordClass("dan??ce") 回傳“cvccv”，wordClass("yucky") 回傳“cvccv”。

我試過這個，但可能有一種更有效的方法來做到這一點：

Function wordClass(word As String) As String
    Dim vowels(1 To 6) As String, vowelsNoY(1 To 5) As String, consonants(1 To 22) As String, pattern(1 To 5) As String
    Dim i As Integer, j As Integer
    
    vowels(1) = "a"
    vowels(2) = "e"
    vowels(3) = "i"
    vowels(4) = "o"
    vowels(5) = "u"
    vowels(6) = "y"
    
    vowelsNoY(1) = "a"
    vowelsNoY(2) = "e"
    vowelsNoY(3) = "i"
    vowelsNoY(4) = "o"
    vowelsNoY(5) = "u"
    
    consonants(1) = "b"
    consonants(2) = "c"
    consonants(3) = "d"
    consonants(4) = "f"
    consonants(5) = "g"
    consonants(6) = "h"
    consonants(7) = "j"
    consonants(8) = "k"
    consonants(9) = "l"
    consonants(10) = "m"
    consonants(11) = "n"
    consonants(12) = "p"
    consonants(13) = "q"
    consonants(14) = "r"
    consonants(15) = "s"
    consonants(16) = "t"
    consonants(18) = "v"
    consonants(19) = "w"
    consonants(20) = "x"
    consonants(21) = "y"
    consonants(22) = "Z"
    
    For h = 1 To Len(consonants)
    
        If StrComp(Mid(word, 1, 1), vowelsNoY(h), vbTextCompare) = 0 Then
            pattern(1) = "v"
        ElseIf StrComp(Mid(word, 1, 1), consonants(h), vbTextCompare) = 0 Then
            pattern(1) = "c"
        End If
    
    Next h
        
    For i = 2 To Len(word)
        
        For j = 2 To Len(word)
            If StrComp(Mid(word, i, 1), vowels(j), vbTextCompare) = 0 Then
                pattern(j) = "v"
            ElseIf StrComp(Mid(word, i, 1), consonants(j), vbTextCompare) = 0 Then
                pattern(j) = "c"
            End If
        Next j
    Next i
            
    wordClass = CStr(pattern)
    
End Function

uj5u.com熱心網友回復：

我不會定義陣列，只需使用 Instr 檢查字符是否在元音內。要檢查輔音，我會檢查該字符是否不是元音并且它在“b”和“z”之間 - 否則它是其他字符。

對我來說，“效率”主要是可讀性問題——無論你使用哪種嘗試，一切都在記憶體中完成，除非你想分析數百萬個單詞，否則不需要優化速度。

我還檢查了第一個字符。如果它是“y”，我將其硬編碼為輔音并從第二個字符開始回圈。

這是我的嘗試：

Function wordClass(ByVal word As String) As String
    Dim i As Long, startIndex As Long
    Const vowels = "aeiouy"
    Const vowel = "V"
    Const consonant = "C"
    Const other = "?"
    
    word = LCase(word)
    If Left(word, 1) = "y" Then
        wordClass = consonant
        startIndex = 2
    Else
        wordClass = ""
        startIndex = 1
    End If
    
    For i = startIndex To Len(word)
        Dim c As String
        c = Mid(word, i, 1)
        If InStr(vowels, c) > 0 Then
            wordClass = wordClass & vowel
        ElseIf c > "a" And c <= "z" Then
            wordClass = wordClass & consonant
        Else
            wordClass = wordClass & other
        End If
    Next

End Function

uj5u.com熱心網友回復：

Option Explicit

Public Sub Example()
    Debug.Print wordClass("dance")
    Debug.Print wordClass("yucky")
End Sub


Public Function wordClass(ByVal word As String) As String
    Const vowels As String = "aeiouy"
    Const vowelsNoY As String = "aeiou"
    Const consonants As String = "bcdfghjklmnopqrstvwxyz"
    
    Dim retval As String

    Dim i As Long
    For i = 1 To Len(word)
        Dim char As String
        char = Mid$(word, i, 1)
        
        If i = 1 Then
            If InStr(vowelsNoY, char) Then
                retval = retval & "v"
            ElseIf InStr(consonants, char) Then
                retval = retval & "c"
            Else
                retval = retval & "-"
            End If
        Else
            If InStr(vowels, char) Then
                retval = retval & "v"
            ElseIf InStr(consonants, char) Then
                retval = retval & "c"
            Else
                retval = retval & "-"
            End If
        End If
    Next i
    
    wordClass = retval
End Function

uj5u.com熱心網友回復：

您可以使用正則運算式分兩步執行此操作。正則運算式可以在字串中搜索單個字母，然后將所有匹配的字母替換為“c”或“v”。您將有 2 個模式和 2 個替換，然后它就會完成。

模式 1 : "[bcdfghjklmnpqrstvwxz]|^y": 匹配該串列中的任何字符或前導 y。

模式 2 : "[aeiouy]": 匹配該串列中的任何字符

由于首先應用模式 1，因此可以安全地假定所有剩余的 y 是元音。此外，由于第一個模式將所有輔音更改為“c”，它們將不匹配模式 2 并被雙重轉換。如果您首先運行元音正則運算式并將字母更改為“v”，則輔音模式將與“v”匹配并且它們都將更改為“c”。所以輔音替換必須首先發生。

Function wordClass(word As String) As String
    Dim Consonants As Object
    Set Consonants = CreateObject("VBScript.RegExp")
    With Consonants
        .Global = True
        .MultiLine = False
        .Pattern = "[bcdfghjklmnpqrstvwxz]|^y"
    End With
    
    Dim Vowels As Object
    Set Vowels = CreateObject("VBScript.RegExp")
    With Vowels
        .Global = True
        .MultiLine = False
        .Pattern = "[aeiouy]"
    End With
    
    Dim outputString As String
    outputString = LCase(word)
    
    outputString = Consonants.Replace(outputString, "c")
    outputString = Vowels.Replace(outputString, "v")
    wordClass = outputString
End Function

uj5u.com熱心網友回復：

我會使用這樣的東西。將其復制到新模塊：

Public strVowels As String
Public arrVowels() As String

Public Function wordClass(strWord As String, Optional blnIncludeY As Boolean = False) As String

Dim lngLetter As Long

    setup blnIncludeY
    
    For lngLetter = 1 To Len(strWord)
        If lngLetter = 1 And LCase(Left(strWord, 1) = "y") Then
            wordClass = "C"
        Else
            If isVowel(Mid(strWord, lngLetter, 1)) Then
                wordClass = wordClass & "V"
            Else
                wordClass = wordClass & "C"
            End If
        End If
    Next lngLetter
    
End Function

Public Sub setup(blnIncludeY As Boolean)

strVowels = "a;e;i;o;u"
If blnIncludeY Then strVowels = strVowels & ";y"

arrVowels = Split(strVowels, ";")

End Sub

Public Function isVowel(strLetter As String)
    isVowel = Not IsError(Application.Match(LCase(strLetter), arrVowels, False))
End Function

uj5u.com熱心網友回復：

好吧，這是另一個答案。這一次，字母和它們的型別用于在字典模式下填充集合，這樣我們可以在掃描單詞時簡化代碼。因此我們只需要處理 y 作為第一個字母的特殊情況。


Private Type State

    LetterType                      As Collection

End Type

Private s                           As State

Public Sub TestWordClass()

    Debug.Print "The word class of Yucky is cvccv: Found is "; WordClass("Yucky")

End Sub


Public Function WordClass(ByVal ipWord As String) As String

    Dim myResult As String
    Dim myFirstLetter As String

    If s.LetterType Is Nothing Then SetupLetterTypes

    myFirstLetter = VBA.LCase$(VBA.Left$(ipWord, 1))
    If myFirstLetter = "y" Then
        
        myResult = "c"

    Else

        myResult = s.LetterType(myFirstLetter)

    End If


    Dim myIndex As Long
    For myIndex = 2 To VBA.Len(ipWord)

        Dim myLetter As String
        myLetter = VBA.LCase$(VBA.Mid$(ipWord, myIndex, 1))
        myResult = myResult & s.LetterType(myLetter)

    Next

    WordClass = myResult

End Function

Private Sub SetupLetterTypes()

    Dim myLetters As Variant
    myLetters = _
        Array _
        ( _
            "aeiouybcdfghjklmnpqrstvwxz", _
            "vvvvvvcccccccccccccccccccc" _
        )
    Set s.LetterType = New Collection

    Dim myIndex As Long
    
    For myIndex = 1 To VBA.Len(myLetters(0))
        
        s.LetterType.Add Item:=VBA.Mid$(myLetters(1), myIndex, 1), Key:=VBA.Mid$(myLetters(0), myIndex, 1)
        
    Next

End Sub

uj5u.com熱心網友回復：

通過陣列匹配替代

這種方法不是將每個單個字母與不同型別的陣列相關聯，而是通過Match在所有字母陣列上執行元音陣列（包括y），一次性單獨獲取元音的序數位置：

    vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)

因此，每個數值對應于一個元音，非發現 ( Error 2042) 對應于一個輔音（“開始 y”- 例外在 b 節中考慮）。

Function cv(ByVal word As String) As String
'a) get position of vowel within vowels array {y.a.e.i.o.u}
    Dim vowelpos
    vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)
'b) consider starting "y" as consonant (i.e. not as vowel)
    If vowelpos(1) = 1 Then vowelpos(1) = "Starting Y"
'c) replace letters with their type abbreviation "v"owel|"c"onsonant
    Dim i As Long
    For i = 1 To UBound(vowelpos)
        vowelpos(i) = IIf(IsNumeric(vowelpos(i)), "v", "c")
    Next i
'd) return joined letter types
    cv = Join(vowelpos, vbNullString)
End Function

幫助函式 s2Arr()

允許將字串原子化為字母陣列。

Function s2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
    s = StrConv(s, vbUnicode)
    s2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/454699.html

標籤：擅长 vba 细绳

上一篇：管理類內的集合

下一篇：編碼Enter鍵