如何获得vba循环结果来填充combobox?

问题:我需要search活动工作簿中的工作表列表,并返回每个工作表的名称,该工作表的单元格的值与searchinput相匹配。 这些工作表的名称然后需要用重复项填充一个用户表单combobox。

部分解决scheme:我已经能够反编译上面大部分代码。 但是,工作表名称当前使用重复填充msgbox。 我将如何使这个结果填充combobox代替?

我一直在试验输出到集合以及将结果写入新的工作表,但是这些选项仍处于概念阶段,所以我没有代码发布。

更新(一些代码):

Public Sub FindDate() 'find date data on all sheets Dim ws As Worksheet Dim rngFind As Range Dim myDate As String Dim firstAddress As String Dim addressStr As String Dim findNum As Integer Dim sheetArray(299) As Integer Dim arrayIndex As Integer myDate = InputBox("Enter date to find") If myDate = "" Then Exit Sub For Each ws In ActiveWorkbook.Worksheets 'Do not search the following sheets With ws If ws.Name = "CM Chapters" Then GoTo myNext If ws.Name = "CM Codes" Then GoTo myNext If ws.Name = "PCS Categories" Then GoTo myNext If ws.Name = "PCS Chapters" Then GoTo myNext If ws.Name = "PCS Code" Then GoTo myNext Set rngFind = .Columns(41).Find(what:=myDate, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) If Not rngFind Is Nothing Then firstAddress = rngFind.Address Do findNum = findNum + 1 addressStr = addressStr & .Name & vbCrLf ''''Original working code ' addressStr = addressStr & .Name & " " & rngFind.Address & vbCrLf ''''Modified to remove excess text Set rngFind = .Columns(41).FindNext(rngFind) Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress End If myNext: End With Next ws If Len(addressStr) Then '''' Original working code ' MsgBox "Found: "" & myDate & "" " & findNum & " times." & vbCr & _ ' addressStr, vbOKOnly, myDate & " found in these cells" '''' Modified to to remove excess text MsgBox vbCr & addressStr Else: MsgBox "Unable to find " & myDate & " in this workbook.", vbExclamation End If End Sub 

尝试这个

 Do findNum = findNum + 1 addressStr = addressStr & .Name ComboBox1.AddItem addressStr 'replace ComboBox1 with your ComboBox name addressStr = addressStr & vbCrLf ' if you still want to add the Line feed Set rngFind = .Columns(41).FindNext(rngFind) Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress 

得到它了。 这是最后的工作代码。 根据原始问题中未包含的附加步骤,variables传递到的位置发生轻微变化。

 Private Sub CboReviewWeek_Change() 'search all worksheets for matching date and return worksheet names to combobox Dim ws As Worksheet Dim rngFind As Range Dim myDate As Date Dim firstAddress As String Dim StrTab As String 'Sets the variable equal to date selected myDate = CboReviewWeek.Value 'object to operate on For Each ws In ActiveWorkbook.Worksheets 'Exclude the following sheets from search With ws If ws.Name = "CM Chapters" Then GoTo myNext If ws.Name = "CM Codes" Then GoTo myNext If ws.Name = "PCS Categories" Then GoTo myNext If ws.Name = "PCS Chapters" Then GoTo myNext If ws.Name = "PCS Code" Then GoTo myNext 'Run Find command on defined range and save result to range variable Set rngFind = .Columns(40).Find(what:=myDate, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 'If cell is populated, then pass said value to string variable If Not rngFind Is Nothing Then firstAddress = rngFind.Address Do 'do this thing 'set string variable equal to name of worksheet StrTab = .Name 'Add string variable value to Combobox Me.CboReviewModule.AddItem StrTab Loop While rngFind.Address <> firstAddress And Not rngFind Is Nothing 'Reset the range to next worksheet and run find again Set rngFind = .Columns(40).FindNext(rngFind) End If End With myNext: Next ws End Sub