| 
    
     |  | ListIndexが-1の時、変数に"*"が入るようにして 比較をLike演算子で行ったらいいかも
 
 UserFormにListBox1〜3が有るとします
 データはSheet1に有り、C2:E2は列見出しとします
 転記先はSheet2とします
 
 Option Explicit
 
 Private rngList As Range
 Private lngRows As Long
 Private vntA As Variant
 Private vntB As Variant
 Private vntC As Variant
 Private rngResult As Range
 Private lngWrite As Long
 
 Private Sub CommandButton1_Click()
 
 Dim i As Long
 
 With rngList
 For i = 1 To lngRows
 If .Offset(i, 0).Value Like vntA Then
 If .Offset(i, 1).Value Like vntB Then
 If .Offset(i, 2).Value Like vntC Then
 lngWrite = lngWrite + 1
 rngResult.Offset(lngWrite).Resize(, 3).Value _
 = .Offset(i).Resize(, 3).Value
 End If
 End If
 End If
 Next i
 End With
 
 End Sub
 
 Private Sub CommandButton2_Click()
 
 Unload Me
 
 End Sub
 
 Private Sub ListBox1_Click()
 
 With ListBox1
 If .ListIndex > -1 Then
 vntA = .List(.ListIndex)
 End If
 End With
 
 End Sub
 
 Private Sub ListBox2_Click()
 
 With ListBox2
 If .ListIndex > -1 Then
 vntB = .List(.ListIndex)
 End If
 End With
 
 End Sub
 
 Private Sub ListBox3_Click()
 
 With ListBox3
 If .ListIndex > -1 Then
 vntC = .List(.ListIndex)
 End If
 End With
 
 End Sub
 
 Private Sub UserForm_Initialize()
 
 Dim i As Long
 Dim vntData As Variant
 
 Set rngList = Worksheets("Sheet1").Cells(2, "C")
 
 Set rngResult = Worksheets("Sheet2").Cells(2, "C")
 
 vntA = "*"
 vntB = "*"
 vntC = "*"
 
 With rngList
 lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
 For i = 0 To 2
 vntData = .Offset(1, i).Resize(lngRows).Value
 Unique Me.Controls("ListBox" & (i + 1)), vntData
 Next i
 End With
 
 End Sub
 
 Private Sub UserForm_Terminate()
 
 Set rngList = Nothing
 Set rngResult = Nothing
 
 End Sub
 
 Private Sub Unique(lstBox As MSForms.ListBox, vntData As Variant)
 
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim vntList As Variant
 
 ReDim vntList(0)
 k = -1
 For i = 1 To UBound(vntData, 1)
 For j = 0 To k
 If vntData(i, 1) = vntList(j) Then
 Exit For
 End If
 Next j
 If j > k Then
 k = k + 1
 ReDim Preserve vntList(k)
 vntList(k) = vntData(i, 1)
 End If
 Next i
 
 lstBox.List = vntList
 
 End Sub
 
 
 |  |