VBA 从列表中选择项目时出现 Combobox 28 错误
VBA Combobox 28 error when selecting item from the list
我正在尝试使用 Excel 的 ComboBox 对象编写一个特定的搜索（它将分离城市和国家的搜索结果）。
当我使用键盘按钮时，一切都很好，搜索也很完美。
但是，当我尝试使用鼠标按钮 select 下拉列表中的项目时，出现 28 错误“堆栈外 space”。
调试器由于未知原因正在循环并最终停止在
Set destination_short_rng = w_search.Range("Destination_short")
下面提供的 ComboBoxDestinations_Change 子例程行。
如能提供任何有关如何防止此错误发生的提示，我将不胜感激。
Private destination_search_rng As Range
Private destination_short_rng As Range
Private destination_search_col As New Collection
Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) Or (KeyCode = vbKeyLButton)
If KeyCode = vbKeyEscape Then UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value
End Sub
Private Sub InitializeDestinationSearchCollection()
Dim num_rows As Integer
Dim i As Integer
num_rows = destination_short_rng.Rows.Count
Set destination_search_col = Nothing
For i = 1 To num_rows
destination_search_col.Add LCase(destination_search_rng.Rows(i).Value)
Next i
End Sub
Private Function SplitText(Text As String, separator As String) As Variant
Dim my_array() As String
Dim i As Integer
my_array = Split(Text, separator)
For i = LBound(my_array, 1) To UBound(my_array, 1)
my_array(i) = LTrim(my_array(i))
Next i
SplitText = my_array
End Function
Private Function FoundDestination(destinations As Variant, entered_txt As String) As Boolean
Dim entered_txt_len As Integer
Dim i As Integer
entered_txt_len = Len(entered_txt)
FoundDestination = False
For i = LBound(destinations, 1) To UBound(destinations, 1)
If left(destinations(i), entered_txt_len) = entered_txt Then
FoundDestination = True
Exit For
End If
Next i
End Function
Private Function LeftDestination(searched_dest As String, entered_txt As String) As Variant
Dim my_array(1 To 2) As Boolean
Dim destinations() As String
Dim cities() As String
Dim countries() As String
destinations = SplitText(searched_dest, ",")
cities = SplitText(destinations(0), "/")
countries = SplitText(destinations(1), "/")
my_array(1) = FoundDestination(cities, entered_txt)
my_array(2) = FoundDestination(countries, entered_txt)
LeftDestination = my_array
End Function
Private Sub printCollection(txt As String, col As Collection, list As Variant)
Dim i As Integer
Debug.Print "Entered txt:", txt
For i = 1 To Application.WorksheetFunction.Min(5, col.Count)
Debug.Print "List item:", list(i - 1, 0)
Debug.Print "Collection item:", col.Item(i)
Next i
End Sub
Private Sub ComboBoxDestinations_Change()
Dim i As Integer
Dim txt As String
Dim entered_txt_len As Integer
Dim entered_txt As String
Dim searched_dest As String
Dim left_cities As Boolean
Dim left_countries As Boolean
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
InitializeDestinationSearchCollection
If Not IsArrowTopDown Then
With UserFormSearchDest.ComboBoxDestinations
.list = destination_short_rng.Value
entered_txt = LCase(.Text)
If Len(entered_txt) > 0 Then
For i = .ListCount - 1 To 0 Step -1
searched_dest = destination_search_col.Item(i + 1)
left_cities = LeftDestination(searched_dest, entered_txt)(1)
left_countries = LeftDestination(searched_dest, entered_txt)(2)
If Not (left_cities) And Not (left_countries) Then
.RemoveItem i
destination_search_col.Remove (i + 1)
End If
Next i
Dim last_left_ind As Integer
Dim is_last_ind_found As Boolean
is_last_ind_found = False
For i = .ListCount - 1 To 0 Step -1
searched_dest = destination_search_col.Item(i + 1)
left_cities = LeftDestination(searched_dest, entered_txt)(1)
left_countries = LeftDestination(searched_dest, entered_txt)(2)
If left_cities And Not (is_last_ind_found) Then
is_last_ind_found = True
last_left_ind = i
End If
If left_countries And Not (left_cities) And is_last_ind_found Then
.AddItem pvargItem:=.list(i), pvargIndex:=last_left_ind + 1
.RemoveItem i
destination_search_col.Add Item:=searched_dest, After:=last_left_ind + 1
destination_search_col.Remove (i + 1)
last_left_ind = last_left_ind - 1
End If
Next i
If .ListCount = 0 Then
.AddItem "No Results"
End If
.DropDown
.ListRows = Application.WorksheetFunction.Min(ListRowsMax, .ListCount)
End If
End With
End If
End Sub
正如评论中已经写的那样，您的问题是更改事件例程正在递归触发自身。
在用户表单上，没有 built-in 机制来防止这种情况发生，但是您自己可以很容易地做到这一点：
声明一个变量（我更喜欢静态变量，因为它们保留在本地，但您也可以将其声明为全局变量）并检查并设置它，以便在递归调用时立即离开例程。
Private Sub ComboBoxDestinations_Change()
Static changeRunning As Boolean
If changeRunning Then Exit Sub
... do your magic here...
changeRunning = False
End Sub
最后，我通过设置 IsMouseDown 和 IsEsc 变量来解决问题。
Private Sub ComboBoxDestinations_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
IsMouseDown = (Button = vbKeyLButton) Or (Button = vbKeyRButton) Or (Button = vbKeyMButton)
End Sub
Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
IsMouseDown = False
IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
IsEsc = KeyCode = vbKeyEscape
If IsEsc Then
UserFormSearchDest.ComboBoxDestinations.Clear
UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value
End If
End Sub
并且在 ComboBoxDestinations_Change 子程序中我写了以下逻辑：
If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then
Private Sub ComboBoxDestinations_Change()
On Error GoTo Err
Dim i As Integer
Dim txt As String
Dim entered_txt_len As Integer
Dim entered_txt As String
Dim searched_dest As String
Dim left_cities As Boolean
Dim left_countries As Boolean
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
InitializeDestinationSearchCollection
If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then
With UserFormSearchDest.ComboBoxDestinations
但是，在极少数情况下（例如，当用户输入其他文本并单击退格键时）可能会发生无限循环。这就是为什么，我写了 On Error GoTo Err 语句，以便在这种情况下停止事件。
总而言之，搜索现在正在运行。
我正在尝试使用 Excel 的 ComboBox 对象编写一个特定的搜索（它将分离城市和国家的搜索结果）。
当我使用键盘按钮时，一切都很好，搜索也很完美。
但是，当我尝试使用鼠标按钮 select 下拉列表中的项目时，出现 28 错误“堆栈外 space”。
调试器由于未知原因正在循环并最终停止在
Set destination_short_rng = w_search.Range("Destination_short")
下面提供的 ComboBoxDestinations_Change 子例程行。
如能提供任何有关如何防止此错误发生的提示，我将不胜感激。
Private destination_search_rng As Range
Private destination_short_rng As Range
Private destination_search_col As New Collection
Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) Or (KeyCode = vbKeyLButton)
If KeyCode = vbKeyEscape Then UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value
End Sub
Private Sub InitializeDestinationSearchCollection()
Dim num_rows As Integer
Dim i As Integer
num_rows = destination_short_rng.Rows.Count
Set destination_search_col = Nothing
For i = 1 To num_rows
destination_search_col.Add LCase(destination_search_rng.Rows(i).Value)
Next i
End Sub
Private Function SplitText(Text As String, separator As String) As Variant
Dim my_array() As String
Dim i As Integer
my_array = Split(Text, separator)
For i = LBound(my_array, 1) To UBound(my_array, 1)
my_array(i) = LTrim(my_array(i))
Next i
SplitText = my_array
End Function
Private Function FoundDestination(destinations As Variant, entered_txt As String) As Boolean
Dim entered_txt_len As Integer
Dim i As Integer
entered_txt_len = Len(entered_txt)
FoundDestination = False
For i = LBound(destinations, 1) To UBound(destinations, 1)
If left(destinations(i), entered_txt_len) = entered_txt Then
FoundDestination = True
Exit For
End If
Next i
End Function
Private Function LeftDestination(searched_dest As String, entered_txt As String) As Variant
Dim my_array(1 To 2) As Boolean
Dim destinations() As String
Dim cities() As String
Dim countries() As String
destinations = SplitText(searched_dest, ",")
cities = SplitText(destinations(0), "/")
countries = SplitText(destinations(1), "/")
my_array(1) = FoundDestination(cities, entered_txt)
my_array(2) = FoundDestination(countries, entered_txt)
LeftDestination = my_array
End Function
Private Sub printCollection(txt As String, col As Collection, list As Variant)
Dim i As Integer
Debug.Print "Entered txt:", txt
For i = 1 To Application.WorksheetFunction.Min(5, col.Count)
Debug.Print "List item:", list(i - 1, 0)
Debug.Print "Collection item:", col.Item(i)
Next i
End Sub
Private Sub ComboBoxDestinations_Change()
Dim i As Integer
Dim txt As String
Dim entered_txt_len As Integer
Dim entered_txt As String
Dim searched_dest As String
Dim left_cities As Boolean
Dim left_countries As Boolean
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
InitializeDestinationSearchCollection
If Not IsArrowTopDown Then
With UserFormSearchDest.ComboBoxDestinations
.list = destination_short_rng.Value
entered_txt = LCase(.Text)
If Len(entered_txt) > 0 Then
For i = .ListCount - 1 To 0 Step -1
searched_dest = destination_search_col.Item(i + 1)
left_cities = LeftDestination(searched_dest, entered_txt)(1)
left_countries = LeftDestination(searched_dest, entered_txt)(2)
If Not (left_cities) And Not (left_countries) Then
.RemoveItem i
destination_search_col.Remove (i + 1)
End If
Next i
Dim last_left_ind As Integer
Dim is_last_ind_found As Boolean
is_last_ind_found = False
For i = .ListCount - 1 To 0 Step -1
searched_dest = destination_search_col.Item(i + 1)
left_cities = LeftDestination(searched_dest, entered_txt)(1)
left_countries = LeftDestination(searched_dest, entered_txt)(2)
If left_cities And Not (is_last_ind_found) Then
is_last_ind_found = True
last_left_ind = i
End If
If left_countries And Not (left_cities) And is_last_ind_found Then
.AddItem pvargItem:=.list(i), pvargIndex:=last_left_ind + 1
.RemoveItem i
destination_search_col.Add Item:=searched_dest, After:=last_left_ind + 1
destination_search_col.Remove (i + 1)
last_left_ind = last_left_ind - 1
End If
Next i
If .ListCount = 0 Then
.AddItem "No Results"
End If
.DropDown
.ListRows = Application.WorksheetFunction.Min(ListRowsMax, .ListCount)
End If
End With
End If
End Sub
正如评论中已经写的那样，您的问题是更改事件例程正在递归触发自身。
在用户表单上，没有 built-in 机制来防止这种情况发生，但是您自己可以很容易地做到这一点：
声明一个变量（我更喜欢静态变量，因为它们保留在本地，但您也可以将其声明为全局变量）并检查并设置它，以便在递归调用时立即离开例程。
Private Sub ComboBoxDestinations_Change()
Static changeRunning As Boolean
If changeRunning Then Exit Sub
... do your magic here...
changeRunning = False
End Sub
最后，我通过设置 IsMouseDown 和 IsEsc 变量来解决问题。
Private Sub ComboBoxDestinations_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
IsMouseDown = (Button = vbKeyLButton) Or (Button = vbKeyRButton) Or (Button = vbKeyMButton)
End Sub
Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
IsMouseDown = False
IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
IsEsc = KeyCode = vbKeyEscape
If IsEsc Then
UserFormSearchDest.ComboBoxDestinations.Clear
UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value
End If
End Sub
并且在 ComboBoxDestinations_Change 子程序中我写了以下逻辑：
If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then
Private Sub ComboBoxDestinations_Change()
On Error GoTo Err
Dim i As Integer
Dim txt As String
Dim entered_txt_len As Integer
Dim entered_txt As String
Dim searched_dest As String
Dim left_cities As Boolean
Dim left_countries As Boolean
Set w_search = Sheets("4c.Travel Costs (Search)")
Set destination_short_rng = w_search.Range("Destination_short")
InitializeDestinationSearchCollection
If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then
With UserFormSearchDest.ComboBoxDestinations
但是，在极少数情况下（例如，当用户输入其他文本并单击退格键时）可能会发生无限循环。这就是为什么，我写了 On Error GoTo Err 语句，以便在这种情况下停止事件。
总而言之，搜索现在正在运行。