| |
▼はるまき さん：
> fd = "0123" ' 検索値
> は複数入力することはできますか？
Sub TEST()
Dim i As Long
Dim j As Long
Dim k As Long
Dim v1 As Variant
Dim s1 As String
Dim s2 As String
Dim fd As Variant
Dim sht As Worksheet
fd = Array("000", "1234", "012", "013")
' 新しいシートの追加1番前へ
Set sht = Worksheets.Add(Before:=Worksheets(1))
' 手動で追加してある場合は
' Set sht = Worksheets(1)
' sht.Cells.ClearContents
sht.Columns("A:B").NumberFormatLocal = "@"
' 2番目のシートから検索
For i = 2 To Worksheets.Count
With Worksheets(i)
v1 = .Range("A1").CurrentRegion.Resize(, 1).Value
v1 = Application.Transpose(v1)
s1 = Join(v1, "")
For k = 0 To UBound(fd)
If Len(fd(k)) <= Len(s1) Then s2 = Left(s1, Len(fd(k)))
If StrComp(fd(k), s2, vbTextCompare) = 0 Then
' あったら新しいシートに
j = j + 1
sht.Cells(j, 1) = .Name
sht.Cells(j, 2) = s2
Exit For '123,1234と言うような検索値が無い場合は
End If
Next
End With
Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
