Excel抽出のマクロかVBAを教えてください

質問

A列にxxxがあった場合、その上に存在するIDの値を抽出する方法を教えていただけますでしょうか？

例）xxxがあった場合、IDの値を抽出したい。
以下の場合、ID:1111とID:3333と表示したい。
(ID以降の値はランダムです)

A列
ID:1111
aaaa
bbbb
cccc
dddd
eexxx　←xxxがあるのでその上のIDを抽出
ffffff
ID:2222
aaaa
bbbb
cccc
dddd
eeee
ffffff
ID:3333
aaaa
bbbb
cccc
dddd
eexxx ←xxxがあるのでその上のIDを抽出
ffffff

回答No.3

tom04 · ベストアンサー

No.2です！
投稿後、気づきました。

同じIDの範囲に複数データがある場合、前回のコードでは重複してIDセルが表示されてしまいますので
↓のコードに変更してください。

Sub Sample2()
Dim i As Long, k As Long, cnt As Long
Range("C:C").ClearContents
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(i, "A"), "xxx") > 0 Then
k = i
Do Until InStr(Cells(k, "A"), "ID") > 0
k = k - 1
Loop
If WorksheetFunction.CountIf(Range("C:C"), Cells(k, "A")) = 0 Then
cnt = cnt + 1
Cells(cnt, "C") = Cells(k, "A")
End If
End If
Next i
End Sub

どうも失礼しました。m(_ _)m

回答No.2

tom04

こんばんは！
色々なアプローチ方法があると思いますが、一例です。

C列にIDを表示させるとします。
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
データはA1セルからあるとします。

Sub Sample1()
Dim i As Long, k As Long, cnt As Long
Range("C:C").ClearContents
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(i, "A"), "xxx") > 0 Then
cnt = cnt + 1
k = i
Do Until InStr(Cells(k, "A"), "ID") > 0
k = k - 1
Loop
Cells(cnt, "C") = Cells(k, "A")
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

回答No.1

keithin

ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim c as range
　dim c0 as string
　dim res as range

　if application.countif(range("A:A"), "*xxx") = 0 then
　　msgbox "NO xxx"
　　exit sub
　elseif application.countif(range("A:A"), "ID:*") = 0 then
　　msgbox "NO ID"
　　exit sub
　end if

　range("C:C").clearcontents
　range("C1") = "FOUND ID"
　set c = range("A:A").find(what:="*xxx", lookin:=xlvalues, lookat:=xlwhole, searchdirection:=xlnext)
　c0 = c.address

　do
　　set res = range("A:A").find(what:="ID:*",after:=c, lookin:=xlvalues, lookat:=xlwhole, searchdirection:=xlprevious)
　　range("C65536").end(xlup).offset(1) = res
　　set c = range("A:A").find(what:="*xxx", after:=c, lookin:=xlvalues, lookat:=xlwhole, searchdirection:=xlnext)
　loop until c.address = c0
end sub

ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８を押し、macro1を実行する。