如何计算句子中单词的长度并在单元格中打印单词?
How to count length of a word from a sentence and print the word(s) in the cell?
我想创建一个函数,从句子中提取所有长度为 2 的单词。例如,如果句子是“The Cat is brown”,我希望单元格中的结果是“is”。如果有多个长度为 2 的词,我也想保留这些词。我已经尝试过 MID、RIGHT、LEFT 等。这些都不起作用,因为单词的位置并不总是相同的。
我不知道如何在 VBA 中执行此操作,欢迎提出任何建议:)
谢谢
我已经为您制作了一个 UDF,它应该可以满足您的需求。你可以这样使用它:
=ExtractWords(Cell to check, Optional number of letters)
默认情况下它会检查 2 个字母的单词,但您也可以像上面显示的那样指定。
这是代码。将其放入模块
Function ExtractWords(Cell As Range, Optional NumOfLetters As Integer)
Dim r As String, i As Long, CurrentString As String, FullString As String, m As String
If NumOfLetters = 0 Then NumOfLetters = 2
r = Cell.Value
For i = 1 To Len(r)
m = Mid(r, i, 1)
If Asc(UCase(m)) >= 65 And Asc(UCase(m)) <= 90 Or m = "-" Or m = "'" Then 'Accepts hyphen or single quote as part of the word
CurrentString = CurrentString & m
If i = Len(r) Then GoTo CheckLastWord
Else
CheckLastWord:
If Len(CurrentString) = NumOfLetters Then
If FullString = "" Then
FullString = CurrentString
Else
FullString = FullString & " " & CurrentString 'Change space if want another delimiter
End If
End If
CurrentString = ""
End If
Next i
If FullString = "" Then
ExtractWords = "N/A" 'If no words are found to contain the length required
Else
ExtractWords = FullString
End If
End Function
可能还有其他更容易或更有效的方法。这只是我想出的。
出现两次大写
在 Excel 中,您可以例如像这样使用它:
=getDUC(A1)
=getDUC(A1," ")
=getDUC(A1,",")
=getDUC(A1,"-")
代码
Option Explicit
' In Excel:
Function getDUC( _
ByVal s As String, _
Optional ByVal Delimiter As String = ", ") _
As String
Dim arr As Variant
arr = DoubleUCaseToArray(s)
getDUC = Join(arr, Delimiter)
End Function
' In VBA:
Sub testDoubleUCaseToArray()
Dim CCodes As Variant: CCodes = Array("US,UKUs", "UkUS,UK", "kUSUKsUK")
Dim arr As Variant
Dim n As Long
For n = LBound(CCodes) To UBound(CCodes)
arr = DoubleUCaseToArray(CCodes(n))
Debug.Print Join(arr, ",")
Next n
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: From a specified string, returns all unique double upper case
' occurrences in a 1D (zero-based) array.
' Remarks: From the string 'USUk' it returns only 'US' (not `SU`).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DoubleUCaseToArray( _
ByVal s As String) _
As Variant
If Len(s) > 1 Then
With CreateObject("Scripting.Dictionary")
Dim cFirst As String * 1
Dim cSecond As String * 1
Dim n As Long
For n = 1 To Len(s) - 1
cFirst = Mid(s, n, 1)
If cFirst Like "[A-Z]" Then
cSecond = Mid(s, n + 1, 1)
If cSecond Like "[A-Z]" Then
.Item(cFirst & cSecond) = Empty
End If
n = n + 1
End If
Next n
If .Count > 0 Then
DoubleUCaseToArray = .Keys
End If
End With
End If
End Function
我想创建一个函数,从句子中提取所有长度为 2 的单词。例如,如果句子是“The Cat is brown”,我希望单元格中的结果是“is”。如果有多个长度为 2 的词,我也想保留这些词。我已经尝试过 MID、RIGHT、LEFT 等。这些都不起作用,因为单词的位置并不总是相同的。
我不知道如何在 VBA 中执行此操作,欢迎提出任何建议:)
谢谢
我已经为您制作了一个 UDF,它应该可以满足您的需求。你可以这样使用它:
=ExtractWords(Cell to check, Optional number of letters)
默认情况下它会检查 2 个字母的单词,但您也可以像上面显示的那样指定。
这是代码。将其放入模块
Function ExtractWords(Cell As Range, Optional NumOfLetters As Integer)
Dim r As String, i As Long, CurrentString As String, FullString As String, m As String
If NumOfLetters = 0 Then NumOfLetters = 2
r = Cell.Value
For i = 1 To Len(r)
m = Mid(r, i, 1)
If Asc(UCase(m)) >= 65 And Asc(UCase(m)) <= 90 Or m = "-" Or m = "'" Then 'Accepts hyphen or single quote as part of the word
CurrentString = CurrentString & m
If i = Len(r) Then GoTo CheckLastWord
Else
CheckLastWord:
If Len(CurrentString) = NumOfLetters Then
If FullString = "" Then
FullString = CurrentString
Else
FullString = FullString & " " & CurrentString 'Change space if want another delimiter
End If
End If
CurrentString = ""
End If
Next i
If FullString = "" Then
ExtractWords = "N/A" 'If no words are found to contain the length required
Else
ExtractWords = FullString
End If
End Function
可能还有其他更容易或更有效的方法。这只是我想出的。
出现两次大写
在 Excel 中,您可以例如像这样使用它:
=getDUC(A1) =getDUC(A1," ") =getDUC(A1,",") =getDUC(A1,"-")
代码
Option Explicit
' In Excel:
Function getDUC( _
ByVal s As String, _
Optional ByVal Delimiter As String = ", ") _
As String
Dim arr As Variant
arr = DoubleUCaseToArray(s)
getDUC = Join(arr, Delimiter)
End Function
' In VBA:
Sub testDoubleUCaseToArray()
Dim CCodes As Variant: CCodes = Array("US,UKUs", "UkUS,UK", "kUSUKsUK")
Dim arr As Variant
Dim n As Long
For n = LBound(CCodes) To UBound(CCodes)
arr = DoubleUCaseToArray(CCodes(n))
Debug.Print Join(arr, ",")
Next n
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: From a specified string, returns all unique double upper case
' occurrences in a 1D (zero-based) array.
' Remarks: From the string 'USUk' it returns only 'US' (not `SU`).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DoubleUCaseToArray( _
ByVal s As String) _
As Variant
If Len(s) > 1 Then
With CreateObject("Scripting.Dictionary")
Dim cFirst As String * 1
Dim cSecond As String * 1
Dim n As Long
For n = 1 To Len(s) - 1
cFirst = Mid(s, n, 1)
If cFirst Like "[A-Z]" Then
cSecond = Mid(s, n + 1, 1)
If cSecond Like "[A-Z]" Then
.Item(cFirst & cSecond) = Empty
End If
n = n + 1
End If
Next n
If .Count > 0 Then
DoubleUCaseToArray = .Keys
End If
End With
End If
End Function