将单词中的字母分类为元音和辅音
To classify letters in words as vowels and consonants
给定一个单词，我需要一个函数 returns 根据元音和辅音来构造单词的结构。 “c”代表辅音，“v”代表元音。如果字母“y”是单词的首字母，则为辅音，否则为元音。例如，wordClass("dance") returns "cvccv" 和 wordClass("yucky") returns "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
我会用这样的东西。将此复制到新模块：
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
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
我不会定义数组，只是使用 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
您可以使用正则表达式分两步完成此操作。 Regex 可以在字符串中搜索单个字母，然后用“c”或“v”替换所有匹配的字母。
你会有 2 个模式和 2 个替换，然后就完成了。
模式 1："[bcdfghjklmnpqrstvwxz]|^y"：匹配该列表中的任何字符或前导 y。
模式 2："[aeiouy]"：匹配该列表中的任何字符
由于首先应用模式 1，因此可以安全地将所有剩余的 y 假定为元音。此外，由于第一个模式将所有辅音更改为“c”，因此它们不会匹配模式 2，而是 double-transformed。如果您首先 运行 元音正则表达式并将字母更改为“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
好吧，这是另一个答案。这次字母和它们的类型用于在字典模式下填充集合，因此我们可以在扫描单词时简化代码。因此我们只需要处理 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
通过数组匹配的替代方法
这种方法不是将每个字母与不同类型的数组相关联，而是通过 Match 一次获得元音的顺序位置，该数组针对元音数组（包括 y):
vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)
因此每个数值对应一个元音，non-findings (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:
s = StrConv(s, vbUnicode)
s2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function
给定一个单词，我需要一个函数 returns 根据元音和辅音来构造单词的结构。 “c”代表辅音，“v”代表元音。如果字母“y”是单词的首字母，则为辅音，否则为元音。例如，wordClass("dance") returns "cvccv" 和 wordClass("yucky") returns "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
我会用这样的东西。将此复制到新模块：
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
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
我不会定义数组，只是使用 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
您可以使用正则表达式分两步完成此操作。 Regex 可以在字符串中搜索单个字母，然后用“c”或“v”替换所有匹配的字母。 你会有 2 个模式和 2 个替换，然后就完成了。
模式 1："[bcdfghjklmnpqrstvwxz]|^y"：匹配该列表中的任何字符或前导 y。
模式 2："[aeiouy]"：匹配该列表中的任何字符
由于首先应用模式 1，因此可以安全地将所有剩余的 y 假定为元音。此外，由于第一个模式将所有辅音更改为“c”，因此它们不会匹配模式 2，而是 double-transformed。如果您首先 运行 元音正则表达式并将字母更改为“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
好吧，这是另一个答案。这次字母和它们的类型用于在字典模式下填充集合，因此我们可以在扫描单词时简化代码。因此我们只需要处理 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
通过数组匹配的替代方法
这种方法不是将每个字母与不同类型的数组相关联，而是通过 Match 一次获得元音的顺序位置，该数组针对元音数组（包括 y):
vowelpos = Application.Match(s2Arr(LCase(word)), Array("y", "a", "e", "i", "o", "u"), 0)
因此每个数值对应一个元音，non-findings (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:
s = StrConv(s, vbUnicode)
s2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function