Question

问题：我需要搜索活动工作簿中的工作表列表，并返回每个工作表的名称，该工作表的值与搜索输入的值匹配。然后，这些工作表的名称需要使用重复项填充userform组合框。

部分解决方案：我已经能够对一段完成上述大部分工作的代码进行逆向工程。但是，工作表名称当前使用重复填充msgbox。我如何使这个结果填充组合框呢？

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

更新（部分代码）：

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

Answer 1

试试这个

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

Answer 2

知道了。这是最终的工作代码。根据原始问题中未包含的其他步骤，变量传递到的位置略有变化。

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

如何获得vba循环结果以填充组合框？

2 个答案: