|
▼ぶたごりら さん:
おはようございます
SHeet2の各列にタイトル行があれば、一発で抽出できますが、とりあえず
タイトル行がない場合のコードです。
(タイトル行をいれてループなしの処理をすることをおすすめしますが)
Private Sub CommandButton1_Click()
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim sx As String
Dim sh1 As Worksheet
Dim c As Range
Dim i As Long
s1 = TextBox1.Value
s2 = TextBox2.Value
s3 = TextBox3.Value
If Len(s1) > 0 Then sx = vbTab & s1
If Len(s2) > 0 Then sx = sx & vbTab & s2
If Len(s3) > 0 Then sx = sx & vbTab & s3
If Len(sx) = 0 Then
MsgBox "抽出すべきキーが入力されていません"
Else
Set sh1 = Sheets("Sheet1")
sh1.Columns("A").ClearContents
With Sheets("Sheet2")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If InStr(sx, c.Value) > 0 Then
i = i + 1
sh1.Cells(i, "A").Value = c.Offset(, 1).Value
End If
Next
End With
End If
End Sub
|
|