我正在VB中编写一个程序，它将从文件中对联系人列表（2D数组）进行排序，然后使用Binary Search Algorithm查找名称starting with user input。然后，我显示找到的名称，以及其余的联系信息。问题是Binary Search Algorithm只搜索了一个名称。我需要找到start with user input的所有名称。
到目前为止，这是我的代码：
Dim found As Boolean = False
Dim search as String = txtInput.Text
Do
middle = CInt((first + last) / 2) 'calcuate the middle position of the scope
If contacts(middle, 1).ToLower.StartsWith(search) Then 'if the middle name starts with the search String
found = True 'name was found
ElseIf contacts(middle, 1).ToLower < search Then 'if the search name comes after the middle position's value
first = middle + 1 'move the first position to be 1 below the middle
ElseIf contacts(middle, 1).ToLower > search Then 'if the search name comes before the middle position's value
last = middle - 1 'move the last position to be 1 above the middle
End If
Loop Until first > last Or found = True 'loop until the name is not found or the name is found
If found = True Then
For x = 0 To 4 'display the whole list of data for that name
txtDisplay.Text += contacts(middle,x).padLeft(15)
Loop
End If
答案 0 :(得分：3)
二进制搜索将“匹配”匹配值列表中的某个位置。如果您希望有多个值可能匹配，则需要从该点向后工作（向A），直到您没有得到匹配，然后再向前（朝向Z）。这是你找到所有部分匹配的方法。如果您不关心它们的显示顺序，您可以将代码的最后部分更改为（类似）：
编辑以包含一些边界检查：
If found = True Then
lb = 0
ub = UBound(contacts)
if middle > lb Then
ii = middle
While contacts(ii, 1).ToLower.StartsWith(search)
ii = ii - 1
if ii < lb Then Exit While
End While
firstContact = ii + 1
Else
firstContact = lb
End If
ii = middle + 1
If middle <= ub Then
ii = middle
While contacts(ii, 1).ToLower.StartsWith(search)
ii = ii + 1
if ii > ub Then Exit While
End While
lastContact = ii - 1
Else
lastContact = ub
End If
numMatching = lastContact - firstContact + 1
Dim matchingContacts(1,1)
ReDim matchingContacts(1 To numMatching, 0 To 4)
For ii = 1 To numMatching
For jj = 0 To 4
matchingContacts(ii, jj) = contacts(firstContact + ii - 1, jj).padLeft(15)
Next jj
Next ii
End If
这应找到匹配联系人的范围，并创建一个仅包含这些联系人的新数组。我没有测试这个 - 所以请原谅错别字（我不经常写VB）。 我添加了一些边界检查;现在不能保证它“完美”......
答案 1 :(得分：0)
您需要创建另一个数组来跟踪找到的名称。
这样想：你找到一个名字，你想找到另一个名字。好吧，其余名称 高于和/或低于找到的名称。 因此，使用while循环检查上方和下方的名称是否与输入匹配，如果匹配，则将它们添加到数组中。
首先，创建一个过程来确定保存所有名称所需的数组大小（需要在设置值之前设置大小）：
'make sure the array is passed as ByRef because it needs to be changed
Private Sub determineSize(ByVal middle As Integer, ByVal search As String, ByRef foundNames() As Integer)
'middle1 and middle2 as the positions (above and below) of the middle position in the search scope
Dim middle1 As Integer = middle, middle2 As Integer = middle
Dim foundTrack As Integer = 0 'number of names found
Do While contacts(middle1, 1).ToLower.StartsWith(search)
foundTrack += 1 '1 more name has been found
If middle1 > 0 Then 'if there are any positions above the current one
middle1 -= 1 'move up 1
Else
Exit Do
End If
Loop
If middle < UBound(contacts, 1) Then 'if there are more names below the current one
middle2 += 1 'this will help to not have a duplicate name from the other list
Do While contacts(middle2, 1).ToLower.StartsWith(search)
foundTrack += 1 'Add 1 to the name found tracker.
If middle2 < UBound(contacts, 1) Then 'if there are any positions below the current one
middle2 += 1 'move the position down to check for another name on the list
Else
Exit Do
End If
Loop
End If
ReDim foundNames(foundTrack - 1) 'set the size to be 1 less than the names found
End Sub
然后创建一个程序，找到所有名称并将这些位置分配给foundNames数组：
Private Sub FindNames(ByVal middle As Integer, ByVal search As String, ByVal foundNames(,) As String)
Dim foundTrack As Integer = 0 'number of names found
'middle1 and middle2 as the positions (above and below) of the middle position in the search scope
Dim middle1 As Integer = middle, middle2 As Integer = middle
Do While contacts(middle1, 1).ToLower.StartsWith(search)
foundTrack += 1 '1 more name has been found
foundNames(foundTrack - 1) = middle 'set the position in the array to be the position of the name found
If middle1 > 0 Then 'if there are any positions above the current one
middle1 -= 1 'move up 1
Else
Exit Do
End If
Loop
If middle < UBound(contacts, 1) Then 'if there are more names on the list below the current position
middle2 += 1 'this will help to not have a duplicate name from the other list
Do While contacts(middle2, 1).ToLower.StartsWith(search)
foundTrack += 1 'Add 1 to the name found tracker.
If middle2 < UBound(contacts, 1) Then 'if there are any positions below the current one
middle2 += 1 'move the position down to check for another name on the list
Else
Exit Do
End If
Loop
End If
End Sub
然后只需编辑您之前的Binary Search Algorithm以合并这些程序：
Dim found As Boolean = False
Dim search as String = txtInput.Text
Dim foundNames() As Integer 'array that holds the row position of each of the found names
Do
middle = CInt((first + last) / 2) 'calcuate the middle position of the scope
If contacts(middle, 1).ToLower.StartsWith(search) Then 'if middle name starts with search string
found = True 'keep track of the fact that the name was found.
Call determineSize(middle, search, foundNames)
Call findNames(middle, search, foundNames)
ElseIf contacts(middle, 1).ToLower < search Then 'if the search name comes after the middle position's value
first = middle + 1 'move the first position to be 1 below the middle
ElseIf contacts(middle, 1).ToLower > search Then 'if the search name comes before the middle position's value
last = middle - 1 'move the last position to be 1 above the middle
End If
Loop Until first > last Or found = True 'loop until the name is not found or the name is found
If found = True Then
For i = 0 To UBound(foundNames)
For j = 0 To 4
txtDisplay.Text += contacts(i,j).padLeft(15)
Loop
Loop
End If
现在您拥有阵列中的位置，以便您可以根据需要对其进行排序。