Question

我是excel-VBA的新手。我在userform中有两（2）个多选列表框。 listbox＃1包含我从工作表（ex.Sheet1）中的一系列单元格中检索的项目列表。如果在列表框＃1中选择的值与sheet2列A中的单元格值匹配，我想向列表框＃2添加新的项目列表。例如，如果列表框＃1中的选定项目与列中的单元格中的值匹配然后获取相邻列的值（列C）并将其添加到列表框＃2。注意：有时A列中有重复值我想从相邻列（“C”）获取所有值。

谢谢！

截图

Screenshot

到目前为止，这是我的代码。

Dim rng1 As Range
Dim rng2 As Range
Dim ws As Worksheet
Dim i As Integer
Dim j As Long
Dim k As Long

    Set ws = Sheets("Class_DataSheet")'from Sheet2

    On Error Resume Next

    For i = 2 To ws.Cells.Find(What:="*", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False).Row Step 1

    Set rng1 = ws.Range("A" & i)
    Set rng2 = ws.Range("C" & i)

    With Schedulefrm.SchedDateTimelist ' Listbox#2
        For k = 0 To Schedulefrm.ClassIDList.ListCount - 1 'ClassIDList is listbox#1
            If Schedulefrm.ClassIDList.Selected(k) Then
                If Schedulefrm.ClassIDList.List(k) = rng1.Value Then
                    .Clear
                    .AddItem rng2.Value 'it adds only one last value of the column ("C") from sheet2
                     For j = 0 To .ListCount - 1
                            .Selected(j) = True
                        Next j
                End If
            End If
        Next k
    End With

    Next i

Answer 1

试试这个

OP对有关重复处理的澄清后

已编辑

选项明确

Private Sub ClassIDList_Change()
    Dim k As Long
    Dim dataIDRng As Range, found As Range
    Dim firstAddress As String

    With Worksheets("Class_DataSheet") 'from Sheet2
        Set dataIDRng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
    End With

    With Schedulefrm
        .SchedDateTimelist.Clear
        With .ClassIDList
            For k = 0 To .ListCount - 1
                If .Selected(k) Then
                    Set found = dataIDRng.Find(What:=.List(k), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                    If Not found Is Nothing Then
                        firstAddress = found.Address '<~~ store the found cell address
                        Do '<~~ start a loop through all range cells to find those matching the selected item. it'll wrap around to the beginning of he range once reached its end
                            Schedulefrm.SchedDateTimelist.AddItem found.Offset(, 2)
                            Set found = dataIDRng.FindNext(found) '<~~ look for next matching cell
                        Loop While found.Address <> firstAddress '<~~ loop until you hit the first found cell again
                    End If
                End If
            Next k
        End With
    End With
End Sub

Answer 2

您可以遍历第一个ListBox并将值传递给此函数。

第二个参数应该只是您要查找值的列范围。该函数从那里开始偏移。

Public Sub FindMyStuff(FindWhat As String, dataRange As Range, ByRef listbox As listbox)
    Dim cell As Range
    For Each cell In dataRange
        If cell.Value = FindWhat Then
            listbox.AddItem cell.Offset(0, 2)
        End If
    Next cell
End Sub

如何从工作表中搜索从useform多选列表框中选择的匹配值或项目？

截图

2 个答案: