需要創建一個宏來計算大型資料集中的所有單詞，其中包含特定單詞的所有字母。它可以包含我的單詞沒有的字母，但必須至少包含我的單詞所包含的所有字母。例如，如果唯一的詞是“Orchids”，則“doctorship”一詞也算在內。
編輯：所有資料都位于 A 列的第 252679 行
我想看看我是否在正確的軌道上，我也不確定我的代碼是否排除了重復字母的計數。
到目前為止，我已經提出了：
Dim count As Long
Dim word As String
Dim row As Long
count = 0
For row = 2 To 252679
word = Cells(row, 1).Value
If InStr(1, word, "a", vbTextCompare) Then
If InStr(1, word, "c", vbTextCompare) Then
If InStr(1, word, "a", vbTextCompare) Then
If InStr(1, word, "d", vbTextCompare) Then
If InStr(1, word, "e", vbTextCompare) Then
If InStr(1, word, "m", vbTextCompare) Then
If InStr(1, word, "y", vbTextCompare) Then
count = count 1
End If
End If
End If
End If
End If
End If
End If
Next row
MsgBox "CountWordsMatchingALL = " & count
uj5u.com熱心網友回復：
你可以這樣做：
Sub Tester()
Debug.Print HasAllLetters("Dog", "done")
Debug.Print HasAllLetters("Cat", "Scatter")
End Sub
'return true if all letters in `myWord` are present in `testWord`
Function HasAllLetters(ByVal myWord As String, ByVal testWord As String) As Boolean
Dim i As Long
'converting to lower case is faster than using `vbTextCompare`
testWord = LCase(testWord) 'case-insensitive
myWord = LCase(myWord)
For i = 1 To Len(myWord)
If Not InStr(testWord, Mid(myWord, i, 1)) > 0 Then Exit Function
Next i
HasAllLetters = True
End Function
uj5u.com熱心網友回復：
計算包含字串所有字符的單元格
Option Explicit
Sub CallCountCellsHaveAllChars()
Dim AllCharsCount As Long
AllCharsCount = CountCellsHaveAllChars(ActiveSheet.Range("A2"), "orchids")
MsgBox "Count of Cells Matching All Characters: " & AllCharsCount
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a one-column range, counts the number of cells whose
' values (strings) contain all characters of a string ('Word').
' Calls: 'RefColumn','GetColumnRange','HasAllChars'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CountCellsHaveAllChars( _
ByVal FirstCell As Range, _
ByVal Word As String) _
As Long
' Create a reference to the one-column range ('crg').
Dim crg As Range: Set crg = RefColumn(FirstCell)
If crg Is Nothing Then Exit Function
' Write the values of the range to a 2D one-based one-column array ('Data').
Dim cData As Variant: cData = GetColumnRange(crg)
' Loop through the array and count the matches.
Dim r As Long
Dim Sentence As String
For r = 1 To UBound(cData, 1)
Sentence = CStr(cData(r, 1))
If HasAllChars(Sentence, Word) Then
CountCellsHaveAllChars = CountCellsHaveAllChars 1
End If
Next r
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the one-column range from the first cell
' of a range ('FirstCell') to the bottom-most non-empty cell
' of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
ByVal FirstCell As Range) _
As Range
If FirstCell Is Nothing Then Exit Function
With FirstCell.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.count - .row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set RefColumn = .Resize(lCell.row - .row 1)
End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values from a column ('ColumnNumber')
' of a range ('rg') to a 2D one-based one-column array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnRange( _
ByVal rg As Range, _
Optional ByVal ColumnNumber As Long = 1) _
As Variant
If rg Is Nothing Then Exit Function
If ColumnNumber < 1 Then Exit Function
If ColumnNumber > rg.Columns.count Then Exit Function
With rg.Columns(ColumnNumber)
If rg.Rows.count = 1 Then
Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
GetColumnRange = Data
Else
GetColumnRange = .Value
End If
End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a boolean indicating whether a string ('Sentence')
' contains all characters of another string ('Word').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function HasAllChars( _
ByVal Sentence As String, _
ByVal Word As String) _
As Boolean
Dim w As Long
For w = 1 To Len(Word)
If InStr(1, Sentence, Mid(Word, w, 1), vbTextCompare) = 0 Then
Exit Function
End If
Next w
HasAllChars = True
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/387213.html