所以花了一點時間比我預料的，但在這裏！如果您之前沒有與Tries一起工作，我建議reading the Wikipedia article。基本上，樹中的每個級別代表數字的一個字符。當數字的末尾向下通過樹時，它是一片葉子，這是存儲值（公司名稱）的位置。無可否認，我在評論代碼方面做得很差，所以如果有什麼特別的你想知道，評論和我可以擴展它。
首先，創建一個clsTrieNode類，像這樣：
Option Explicit
Public parent As clsTrieNode
Public value As String
Public count As Long
Public digit As String
'Arrays are not allowed to be public members of classes, sadly
Private m_children(0 To 9) As clsTrieNode
Public Property Get children(i As Byte) As clsTrieNode
Set children = m_children(i)
End Property
Public Property Set children(i As Byte, node As clsTrieNode)
Set m_children(i) = node
End Property
接下來，創建clsNumberTrie像這樣：
Option Explicit
Private head As clsTrieNode
Private Sub Class_Initialize()
Set head = New clsTrieNode
End Sub
Public Sub Add(key As String, value As String)
Dim temp As clsTrieNode
Set temp = head
Dim i As Long
Dim key_digit As Byte
For i = 1 To Len(key)
key_digit = Val(Mid(key, i, 1))
If Not temp.children(key_digit) Is Nothing Then
Set temp = temp.children(key_digit)
Else
Set temp.children(key_digit) = New clsTrieNode
Set temp.children(key_digit).parent = temp
Set temp = temp.children(key_digit)
temp.digit = key_digit 'implicit string conversion
End If
Next
temp.value = value
mergeTrieUpwards temp.parent
End Sub
Private Sub mergeTrieUpwards(node As clsTrieNode)
If isMergeable(node) Then
node.value = node.children(0).value
Dim i As Byte
For i = 0 To 9
Set node.children(i) = Nothing
Next
mergeTrieUpwards node.parent
End If
End Sub
Private Function isMergeable(node As clsTrieNode) As Boolean
Dim i As Byte
'Firstly, node must be defined (e.g., not the parent of head)
If node Is Nothing Then
isMergeable = False
Exit Function
End If
For i = 0 To 9
'Secondly, all children must be defined
If node.children(i) Is Nothing Then
isMergeable = False
Exit Function
'Thirdly, all children must be leaves
ElseIf node.children(i).value = "" Then
isMergeable = False
Exit Function
End If
Next
isMergeable = True
End Function
Public Function toString() As String
Dim strKey As String
Dim strOutput As String
If Not head Is Nothing Then
strOutput = toStringRecurse("", head)
End If
toString = strOutput
End Function
Private Function toStringRecurse(prefix As String, node As clsTrieNode) As String
Dim strOutput As String
Dim i As Byte
If node.value <> "" Then
toStringRecurse = prefix & node.digit & " " & node.value & vbCrLf
Exit Function
Else
For i = 0 To 9
If Not node.children(i) Is Nothing Then
strOutput = strOutput & toStringRecurse(prefix & node.digit, node.children(i))
End If
Next
toStringRecurse = strOutput
End If
End Function
最後，運行它針對你輸入數字，我有在以下一個名爲mdlMain的模塊。我推出了我自己的Split，因爲內置的Split不支持忽略連續的分隔符，並且您的輸入具有可變數量的空格。
Public Sub Main()
Dim input_data As String
input_data = "3734 CompanyA" & vbCrLf & _
"3735 CompanyA" & vbCrLf & _
"375 CompanyA" & vbCrLf & _
"3760 CompanyA" & vbCrLf & _
"3761 CompanyA" & vbCrLf & _
"3762 CompanyA" & vbCrLf & _
"3763 CompanyA" & vbCrLf & _
"3764 CompanyA" & vbCrLf & _
"3765 CompanyA" & vbCrLf & _
"3766 CompanyA" & vbCrLf & _
"3767 CompanyA" & vbCrLf & _
"3768 CompanyA" & vbCrLf & _
"3769 CompanyA" & vbCrLf & _
"3770 CompanyA" & vbCrLf & _
"3771 CompanyA" & vbCrLf & _
"3773 CompanyB" & vbCrLf & _
"3774 CompanyB" & vbCrLf & _
"3775 CompanyB" & vbCrLf & _
"3776 CompanyB" & vbCrLf & _
"3778 CompanyB" & vbCrLf & _
"33045 CompanyB" & vbCrLf & _
"361 CompanyB"
Dim companyTrie As clsNumberTrie
Set companyTrie = New clsNumberTrie
Dim rows As Variant
Dim row As Variant
rows = SplitStr(input_data, vbCrLf)
Dim i As Long
For i = 0 To UBound(rows)
row = SplitStr(CStr(rows(i)), " ", True)
companyTrie.Add CStr(row(0)), CStr(row(1))
Next
Debug.Print companyTrie.toString
End Sub
'This implementation of split has supports ignoring consecutive delimiters
Public Function SplitStr(str As String, delim As String, Optional treatSuccessiveDelimitersAsOne = False) As Variant
'This is not an optimal implementation:
'1. Resizing an array is expensive because it requires copying the whole thing.
'2. String concatenation has the same problem; new memory is allocated to hold the result, and then both strings are copied to this new location.
'Thankfully, with the small strings in this example, it doesn't matter too much.
Dim i As Long
Dim outArr() As String
ReDim outArr(0 To 0)
'Iterate through the string
For i = 1 To Len(str)
'If the current character is the start of the delimiter...
If Mid(str, i, 1) = Mid(delim, 1, 1) Then
'Check and see if the whole delimiter is there...
If isSubstringDelim(str, i, delim) Then
'If so, jump i past the delimiter and add a new slot to the split array
i = i + Len(delim)
ReDim Preserve outArr(0 To (UBound(outArr) + 1))
'Check to see if there are multiple delimiters in a row...
While isSubstringDelim(str, i, delim)
i = i + Len(delim)
'If treatSuccessiveDelimitersAsOne is False, we add a blank string to the split array each time we encounter a successive delimiter.
'If it's true, just consume the delimiters without creating a blank string
If Not treatSuccessiveDelimitersAsOne Then
ReDim Preserve outArr(0 To (UBound(outArr) + 1))
End If
Wend
End If
End If
'Add the current character to the current slot of the split array
outArr(UBound(outArr)) = outArr(UBound(outArr)) + Mid(str, i, 1)
Next
SplitStr = outArr
End Function
Private Function isSubstringDelim(str, index, delim) As Boolean
Dim min As Long
If (Len(str) - index) < Len(delim) Then
isSubstringDelim = False
Exit Function
End If
For i = 1 To Len(delim)
If Not (Mid(str, i + index - 1, 1) = Mid(delim, i, 1)) Then
isSubstringDelim = False
Exit Function
End If
Next
isSubstringDelim = True
End Function
由於訪問節點的方式，結果以字母順序輸出。需要注意的是它支持遞歸分組，因此，如果您通過3358當初公司爲3351，但你也33591已通過33599的公司，它會挽起3359，然後再彙總335
33045 361 CompanyB CompanyB
3735 3734公司公司公司
375 376公司
3770公司公司3771 3773 CompanyB
CompanyB
CompanyB 3775 3776 3778 CompanyB
CompanyB
那我相信你會找到的東西，你可以複製和粘貼。很可能你需要自己創建一個解決方案。 – Tomalak
是否有邏輯，多麼深的分組他們應該還是應該去申請？例如，爲什麼不「公司3734」和「3735公司」分組踏踏實實地「373公司」。另外，你怎麼知道一個數字代表多少個數字？難道是一直被認爲是填充爲9與0右側的長度可見的數字？ – Blackhawk
@Blackhawk數字可以達到8位，而第三位的4位數字爲包括一個它必須涵蓋所有排列，即它必須是明確表示，公司旗下擁有公司3730-3739分組踏踏實實地373如果這有意義？ – User632716