3日前ぐらいから書いてたコード。
やっと動いてくれたよ!
Sub Search() Dim StartTime, StopTime As Variant Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet Dim n As Long, i As Long, m As Long Dim Term As String Dim objFind As Object Dim Address As String StartTime = Time Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") Set ws3 = Worksheets("Sheet3") Set ws4 = Worksheets("Sheet4") n = 1 m = 1 For i = 1 To 25328 Term = ws1.Cells(i, 1).Value If (Term = "*") Or (Term = "***") Or (Term = "*********") Or (Term = "*********************") Or (Term = "*************************") Then Term = "~*" End If If Term = "?" Or Term = "??" Or Term = "???" Or Term = "?????" Then Term = "~?" End If If Term = "-" Then Term = "~-" End If 'What:=検索文字列 ,LooKIn:=検索対象, LookAt:=一部か全部か, SearchOrder:=検索方向, MatchByte:=半角全角区別 'Set objFind = ws2.Range("A1:A391").Find(What:=(Term), LookIn:=xlValues, LookAt:=xlWhole) Set objFind = ws2.Range("A1:A391").Find(What:=(Term), LookIn:=xlValues, LookAt:=xlWhole) If Not objFind Is Nothing Then Address = objFind.Address Do If ws1.Cells(i, 58).Value <> 0 Then ws1.Rows(i).Copy ws3.Rows(n) ws4.Cells(n, 1).Value = i n = n + 1 End If 'Set objFind = Cells.FindNext(objFind) Set objFind = ws2.Range("A1:A391").FindNext(objFind) Loop While Not objFind Is Nothing And objFind.Address <> Address Else 'MsgBox Term + "は見つかりませんでした。" End If Next StopTime = Time StopTime = StopTime - StartTime MsgBox "所要時間は" & Minute(StopTime) & "分" & Second(StopTime) & "秒 でした" End Sub
これ書いていてつまったところ。
エクセルで文字列検索するときに、ワイルドカードなるものがある。
「*」「?」「-」などは任意文字?みたいなので、どんな文字でもマッチングしちゃう。
それのせいでなんかマッチングしまくってコピーしまくり。
あとオブジェクト。
このオブジェクトが、よく聞くオブジェクト指向と関係があるかは分からないけど。
これちょっとややこしかった。
多分もっとキレイに書けるんだろうけど、とりあえず動いたので良かった。