完全披露，这是 Chandoo
上帖子的延续我是 VBA 菜鸟。我得到了帮助才能走到这一步。我的文件链接如下。为什么我的列表框只显示一行/结果？当我选择组合框值 + 文本框值时，我没有获得所有匹配结果。
例如...
打开用户表单转到标题为“搜索现有订单”的框架 基于多个标准 转到组合框，然后选择“商店” 订单”进入文本框输入“A”点击搜索按钮
列表框仅显示一行/结果。如果清除搜索，您可以看到有 4 行符合搜索条件。
提前谢谢您！
Private Sub UserForm_Initialize()
'redacted code
Sheets("Master").Activate
'***Populates the listbox and only displays 9 columns. Remaining columns are hidden by entering '0' width.***
lstMaster.ColumnWidths = "0;0;40;80;0;0;0;0;0;0;0;0;50;0;0;0;0;0;0;0;0;60;0;0;0;0;0;0;0;0;50;40;0;0;0;0;0;70;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;"
lstMaster.ColumnCount = 106 'Number of Columns in the ListBox
lstMaster.List = Sheets("Master").Range("A4:DB" & Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row).Value
'***Add items to combobox list. Each list item MUST match their respective column header.
cboSearchItem.AddItem "Shop Order"
cboSearchItem.AddItem "Suffix"
cboSearchItem.AddItem "Proposal"
cboSearchItem.AddItem "PO"
cboSearchItem.AddItem "SO"
cboSearchItem.AddItem "Quote"
cboSearchItem.AddItem "Transfer Order"
cboSearchItem.AddItem "Customer Name"
cboSearchItem.AddItem "End User Name"
'redacted code
End Sub
'***Search Multiple Orders Button***
Private Sub cmbSearchOrders_Click()
Dim sat, s As Long
Dim deg1, deg2 As String 'deg1 = cells(Row Index,Column Letter); 'deg2 = txtSearch.Value
'***Message popups if search value and/or search criteria are blank***
Sheets("Master").Activate
Application.ScreenUpdating = False 'Setting to 'false' speeds up the macro
If Me.txtSearch.Value = "" Then 'Condition if the textbox is blank
MsgBox "Please enter a search value.", vbOKOnly + vbExclamation, "Search" 'vbOKOnly shows only the OK button, vbExclamation shows exclamation point icon
txtSearch.SetFocus
Exit Sub
End If
If cboSearchItem.Value = "" Then ' Condition if combobox is blank
MsgBox "Please select search criteria.", vbOKOnly + vbExclamation, ""
cboSearchItem.SetFocus
Exit Sub
End If
With lstMaster
.Clear
.ColumnCount = 106
.ColumnWidths = "0;0;40;80;0;0;0;0;0;0;0;0;50;0;0;0;0;0;0;0;0;60;0;0;0;0;0;0;0;0;50;40;0;0;0;0;0;70;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;"
End With
'***Progress Bar***
Call Main
deg2 = txtSearch.Value
Select Case cboSearchItem.Value
Case "Shop Order"
RN = 4 'column number
Case "Suffix"
RN = 3
Case "Proposal"
RN = 13
Case "PO"
RN = 22
Case "SO"
RN = 31
Case "Quote"
RN = 32
Case "Transfer Order"
RN = 38
Case "Customer Name"
RN = 79
Case "End User Name"
RN = 102
End Select
For sat = 4 To Cells(Rows.Count, RN).End(xlUp).Row
deg1 = Cells(sat, RN)
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive
lstMaster.AddItem
For c = 0 To 105 'column index
lstMaster.List(s, c) = Cells(sat, c + 1) 'c+1 = column index + 1 = column number
Next c
End If
Next
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
'***1 of 2 Search Results in Listbox***
Private Sub txtSearch_Change()
On Error Resume Next
lijst = [Master].Value
arg = 0
For i = 1 To UBound(lijst) 'gets the maximum length of the array lijst
If InStr(1, lijst(i, 1), txtSearch, vbTextCompare) > 0 Then
arg = arg + 1
End If
Next i
ReDim nwlijst(arg - 1, 106)
arg = 0
For i = 1 To UBound(lijst)
If InStr(1, lijst(i, 1), txtSearch, vbTextCompare) > 0 Then
For K = 1 To 106
nwlijst(arg, K - 1) = lijst(i, K)
Next K
arg = arg + 1
End If
Next
lstResults.List = nwlijst
End Sub
'***2 of 2 Search Results in Listbox***
Sub Reset()
With lstResults
.List = [Master].Value
.ListIndex = -1
End With
cmbNew.Enabled = True
cmbSave.Enabled = True
For Each ctrl In Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "CheckBox" Then ctrl.Value = ""
Next ctrl
End Sub
我需要缩短代码，因为当我添加第九列时，我达到了单个过程中代码长度的限制。这是原始的长代码，可以工作，但仅适用于八个列表框列。我得到了帮助来缩短代码并包括第九列。根据我上面的帖子，我只在列表框中得到一个结果/行。请注意，这个“旧”代码在工作表（“MASTER”）中显示了 114 列。我的新版本有 106。
'***Search Button***
Private Sub cmbSearch_Click()
Dim sat, s As Long
Dim deg1, deg2 As String 'deg1 = cells(Row Index,Column Letter)and deg2 = txtSearch.Value
'redacted code
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
With lstMaster
.Clear
.ColumnCount = 114
.ColumnWidths = "65;0;0;0;0;0;0;0;0;0;40;0;45;0;0;0;0;0;0;0;45;0;0;0;0;0;0;0;0;42;30;0;0;0;0;0;60;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;75;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;"
End With
'***Progress Bar***
Call Main
deg2 = txtSearch.Value
Select Case cboSearchItem.Value
'***Search for Shop Order Number***
Case "Shop Order"
For sat = 3 To Cells(Rows.Count, 1).End(xlUp).Row
deg1 = Cells(sat, "A") 'Row Index = 'sat', Column Index = 'A'
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive as long as you do not assign a case to txtSearch
lstMaster.AddItem 'Using column index which starts with '0' vs column number which starts with '1'
lstMaster.List(s, 0) = Cells(sat, "A") 'Shop Order Number
lstMaster.List(s, 1) = Cells(sat, "B") 'Email Subject Line
lstMaster.List(s, 2) = Cells(sat, "C") 'Stage
lstMaster.List(s, 3) = Cells(sat, "D") 'Stage Due
lstMaster.List(s, 4) = Cells(sat, "E") 'E10 Status
lstMaster.List(s, 5) = Cells(sat, "F") 'Start Date
lstMaster.List(s, 6) = Cells(sat, "G") 'End Date
lstMaster.List(s, 7) = Cells(sat, "H") 'Days To Process
lstMaster.List(s, 8) = Cells(sat, "I") 'Reason
lstMaster.List(s, 9) = Cells(sat, "J") 'Prefix
lstMaster.List(s, 10) = Cells(sat, "K") 'Suffix
lstMaster.List(s, 11) = Cells(sat, "L") 'Notes
lstMaster.List(s, 12) = Cells(sat, "M") 'Proposal Number
lstMaster.List(s, 13) = Cells(sat, "N") 'Salesperson
lstMaster.List(s, 14) = Cells(sat, "O") 'Proposal Date
lstMaster.List(s, 15) = Cells(sat, "P") 'Lead Time
lstMaster.List(s, 16) = Cells(sat, "Q") 'Promised Date
lstMaster.List(s, 17) = Cells(sat, "R") 'Expiration Date
lstMaster.List(s, 18) = Cells(sat, "S") 'Cost
lstMaster.List(s, 19) = Cells(sat, "T") 'Margin
lstMaster.List(s, 20) = Cells(sat, "U") 'PO
lstMaster.List(s, 21) = Cells(sat, "V") 'PO Date
lstMaster.List(s, 22) = Cells(sat, "W") 'PO Received Date
lstMaster.List(s, 23) = Cells(sat, "X") 'PO Amount
lstMaster.List(s, 24) = Cells(sat, "Y") 'PO Terms
lstMaster.List(s, 25) = Cells(sat, "Z") 'Ship Via
lstMaster.List(s, 26) = Cells(sat, "AA") 'Ship Type
lstMaster.List(s, 27) = Cells(sat, "AB") 'Ship Charges
lstMaster.List(s, 28) = Cells(sat, "AC") 'Shipping Instructions
lstMaster.List(s, 29) = Cells(sat, "AD") 'SO
lstMaster.List(s, 30) = Cells(sat, "AE") 'Quote
lstMaster.List(s, 31) = Cells(sat, "AF") 'Project Manager
lstMaster.List(s, 32) = Cells(sat, "AG") 'Short System Description
lstMaster.List(s, 33) = Cells(sat, "AH") 'Long System Description
lstMaster.List(s, 34) = Cells(sat, "AI") 'S-Code
lstMaster.List(s, 35) = Cells(sat, "AJ") 'BMTH
lstMaster.List(s, 36) = Cells(sat, "AK") 'Transfer Order Number
lstMaster.List(s, 37) = Cells(sat, "AL") 'Installation Days
lstMaster.List(s, 38) = Cells(sat, "AM") 'Start Up Days
lstMaster.List(s, 39) = Cells(sat, "AN") 'Training Days Onsite
lstMaster.List(s, 40) = Cells(sat, "AO") 'Training Days In Toledo
lstMaster.List(s, 41) = Cells(sat, "AP") 'Vendor Field Service Days
lstMaster.List(s, 42) = Cells(sat, "AQ") 'Service Technician
lstMaster.List(s, 43) = Cells(sat, "AR") 'Standard Hours 1st & 2nd Shift
lstMaster.List(s, 44) = Cells(sat, "AS") 'Standard Hours 3rd Shift
lstMaster.List(s, 45) = Cells(sat, "AT") 'Saturday, Sunday or Holidays
lstMaster.List(s, 46) = Cells(sat, "AU") 'Additional Overtime
lstMaster.List(s, 47) = Cells(sat, "AV") 'Travel Less Than 8 Hours
lstMaster.List(s, 48) = Cells(sat, "AW") 'Travel More Than 8 Hours
lstMaster.List(s, 49) = Cells(sat, "AX") 'Airfare
lstMaster.List(s, 50) = Cells(sat, "AY") 'Hotel
lstMaster.List(s, 51) = Cells(sat, "AZ") 'Car Rental
lstMaster.List(s, 52) = Cells(sat, "BA") 'Meals
lstMaster.List(s, 53) = Cells(sat, "BB") 'Mileage
lstMaster.List(s, 54) = Cells(sat, "BC") 'Parking
lstMaster.List(s, 55) = Cells(sat, "BD") 'Service Parts 1
lstMaster.List(s, 56) = Cells(sat, "BE") 'Service Parts 2
lstMaster.List(s, 57) = Cells(sat, "BF") 'Booking Fees
lstMaster.List(s, 58) = Cells(sat, "BG") 'Total
lstMaster.List(s, 59) = Cells(sat, "BH") 'Service Group
lstMaster.List(s, 60) = Cells(sat, "BI") 'Repair Technician
lstMaster.List(s, 61) = Cells(sat, "BJ") 'Repair1
lstMaster.List(s, 62) = Cells(sat, "BK") 'Amt1
lstMaster.List(s, 63) = Cells(sat, "BL") 'Repair2
lstMaster.List(s, 64) = Cells(sat, "BM") 'Amt2
lstMaster.List(s, 65) = Cells(sat, "BN") 'Repair3
lstMaster.List(s, 66) = Cells(sat, "BO") 'Amt3
lstMaster.List(s, 67) = Cells(sat, "BP") 'Repair4
lstMaster.List(s, 68) = Cells(sat, "BQ") 'Amt4
lstMaster.List(s, 69) = Cells(sat, "BR") 'Repair5
lstMaster.List(s, 70) = Cells(sat, "BS") 'Amt5
lstMaster.List(s, 71) = Cells(sat, "BT") 'Repair6
lstMaster.List(s, 72) = Cells(sat, "BU") 'Amt6
lstMaster.List(s, 73) = Cells(sat, "BV") 'Repair7
lstMaster.List(s, 74) = Cells(sat, "BW") 'Amt7
lstMaster.List(s, 75) = Cells(sat, "BX") 'Repair8
lstMaster.List(s, 76) = Cells(sat, "BY") 'Amt8
lstMaster.List(s, 77) = Cells(sat, "BZ") 'Repair Total
lstMaster.List(s, 78) = Cells(sat, "CA") 'Repair Group
lstMaster.List(s, 79) = Cells(sat, "CB") 'CustID
lstMaster.List(s, 80) = Cells(sat, "CC") 'Customer Name
lstMaster.List(s, 81) = Cells(sat, "CD") 'Bill To
lstMaster.List(s, 82) = Cells(sat, "CE") 'Address1
lstMaster.List(s, 83) = Cells(sat, "CF") 'Address2
lstMaster.List(s, 84) = Cells(sat, "CG") 'City
lstMaster.List(s, 85) = Cells(sat, "CH") 'State
lstMaster.List(s, 86) = Cells(sat, "CI") 'ZipCode
lstMaster.List(s, 87) = Cells(sat, "CJ") 'Country
lstMaster.List(s, 88) = Cells(sat, "CK") 'Diamond Distributor
lstMaster.List(s, 89) = Cells(sat, "CL") 'Tax Exempt
lstMaster.List(s, 90) = Cells(sat, "CM") 'Contact 1 Name
lstMaster.List(s, 91) = Cells(sat, "CN") 'Contact 1 Email
lstMaster.List(s, 92) = Cells(sat, "CO") 'Contact 2 Name
lstMaster.List(s, 93) = Cells(sat, "CP") 'Contact 2 Email
lstMaster.List(s, 94) = Cells(sat, "CQ") 'Ship To ID
lstMaster.List(s, 95) = Cells(sat, "CR") 'Ship To Name
lstMaster.List(s, 96) = Cells(sat, "CS") 'Ship To Address 1
lstMaster.List(s, 97) = Cells(sat, "CT") 'Ship To Address 2
lstMaster.List(s, 98) = Cells(sat, "CU") 'Ship To City
lstMaster.List(s, 99) = Cells(sat, "CV") 'Ship To State
lstMaster.List(s, 100) = Cells(sat, "CW") 'Ship To Zip Code
lstMaster.List(s, 101) = Cells(sat, "CX") 'Ship To Country
lstMaster.List(s, 102) = Cells(sat, "CY") 'End User Name
lstMaster.List(s, 103) = Cells(sat, "CZ") 'EUID
lstMaster.List(s, 104) = Cells(sat, "DA") 'Entered In E10
lstMaster.List(s, 105) = Cells(sat, "DB") 'Confirmation Of PO
lstMaster.List(s, 106) = Cells(sat, "DC") 'Request Approval (Finance)
lstMaster.List(s, 107) = Cells(sat, "DD") 'Request PM
lstMaster.List(s, 108) = Cells(sat, "DE") 'PM Assigned
lstMaster.List(s, 109) = Cells(sat, "DF") 'SO To Team/PM
lstMaster.List(s, 110) = Cells(sat, "DG") 'Approved (Finance)
lstMaster.List(s, 111) = Cells(sat, "DH") 'SOA To Customer
lstMaster.List(s, 112) = Cells(sat, "DI") 'SOA Date In E10
lstMaster.List(s, 113) = Cells(sat, "DJ") 'Request Invoice
s = s + 1
End If
Next
'redacted code for remaining Cases which each have the same number of code lines as Case "Shop Order"
End Sub
'***Search Results in Listbox 1 of 2***
Private Sub txtSearch_Change()
'redacted because it is the same code as above
End Sub
'***Search Results in Listbox 2 of 2***
Sub Reset()
'redacted because it is the same code as above
End Sub
您有
lstMaster.List(s, c) = Cells(sat, c + 1)添加一行以递增
sFor sat = 4 To Cells(Rows.Count, RN).End(xlUp).Row
deg1 = Cells(sat, RN)
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive
lstMaster.AddItem
For c = 0 To 105 'column index
lstMaster.List(s, c) = Cells(sat, c + 1) 'c+1 = column index + 1 = column number
Next c
s = s + 1 '<<<<<<<<<<<<<<<<
End If
Next