エクセルVBAでの文字列抽出とセルへの出力

質問

エクセルVBAで文字列を検索して、検索した文字列を他のセルへ出力する方法を探しております。状況を図で説明すると、

A1セル：aaa\bbb\item1\ddd
A2セル：aaa\bbb\ccc\item2\ddd
A3セル：aaa\bbb\ccc\ddd\item3\eee

このような状態からitemを検索して、B1セルに

B1セル：item1
B2セル：item2
B3セル：item3

と表示させたいです。エクセルVBA初心者なものでRegExpを使うのかな、というところまではたどり着きましたが、そこから先にすすめません。
何か良い方法をご存知の方、教えていただきたいです。よろしくお願いいたします。

回答No.4

xls88

色々やり方はあるとおもいます。
Split関数を使ってみました。
確かExcel2000以降、実装されているVBA関数です。

Sub test()
　　Dim v As Variant
　　Range("A1").Select
　　While ActiveCell <> ""
　　　　v = Split(ActiveCell.Value, "\")
　　　　ActiveCell.Offset(,1).Value = v(UBound(v) - 1)
　　　　ActiveCell.Offset(1).Select
　　Wend
End Sub

回答No.3

pkh4989

VBScript.Regexp の機能は凄いですね。
簡単に以下の方法も・・・

Sub test()
　　Dim mRow　　　　　　As Long
　　Dim wStr　　　　　　As String
　　Dim i, j, k　　　　 As Integer
　　'
　　With ActiveSheet
　　　　For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　wStr = .Cells(i, 1)
　　　　　　j = InStr(1, wStr, "item")
　　　　　　k = InStr(j, wStr, "\")
　　　　　　'
　　　　　　.Cells(i, 2) = Mid(wStr, j, k - j)
　　　　Next
　　End With
End Sub

お礼

無事できました。
Withを使ったりするのにまだ慣れてないですが、頑張って覚えていこうと思います。
本当にありがとうございました。

回答No.2

nebsoku

きたないコードになってしまったのですが・・・
最後の\と最後から2番目の\の間の文字を抽出するコードを考えてみました。
もっときれいにできるはずなので、後はご自分でどうぞ＾＾；

Dim Str As String
Dim LastRow, Characters As Integer
Dim i, j, Yen As Integer
Dim Len1, Len2 As Integer

Yen = 1

Range("A1").End(xlDown).Select
LastRow = Selection.Row

For i = 1 To LastRow

Str = Cells(i, 1)
Characters = Len(Cells(i, 1))

For j = Characters To 1 Step -1
If Mid(Str, j, 1) = "\" Then
If Yen = 1 Then
Len1 = j
End If
If Yen = 2 Then
Len2 = j + 1
End If
Yen = Yen + 1
End If
Next j

Yen = 1
Cells(i, 2) = Mid(Str, Len2, Len1 - Len2)

Next i

回答No.1

n-jun

Sub　test()
　Dim　v　As　Variant
　Dim　i　As　Integer
　Dim　Matches
　Dim　Match

　v　=　Array("aaa\bbb\item1\ddd",　"aaa\bbb\ccc\item2\ddd",　"aaa\bbb\ccc\ddd\item3\eee")

　With　CreateObject("VBScript.Regexp")
　　　　　　.Pattern　=　"item\d*"
　　　　　　.Global　=　True
　　　　　　For　i　=　0　To　2
　　　　　　　　　　If　.test(v(i))　Then
　　　　　　　　　　　　　Set　Matches　=　.Execute(v(i))
　　　　　　　　　　　　　For　Each　Match　In　Matches
　　　　　　　　　　　　　　　　　MsgBox　Match.Value
　　　　　　　　　　　　　Next
　　　　　　　　　　End　If
　　　　　　Next
　End　With
End　Sub
この様な事でしょうか。

お礼

このやり方でもいけますね。
皆様のおかげで本当に助かりました。
ありがとうございました。