| |
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/11/14(金) 13:30 -
