Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

50004 / 76738

←次へ　｜　前へ→


	【31631】Re:文字の抽出からコピー

ichinose - 05/11/27(日) 15:06 -


	引用なし

	パスワード

とまとさん、超ビギナーさん
こんにちは。

アルゴリズムを駆使すればできそうですけど
正規表現を使用するとあまり考えなくても
この手のことが実現出来ますよ！！

標準モジュールに
'=========================================
Dim regex As Object
Sub test()
　 Set regex = CreateObject("VBScript.RegExp")
　 ' 正規表現を作成します。
　 For idx = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　 jdx = 0
　　 If Cells(idx, 1).Value <> "" Then
　　　　ans = spfind(Cells(idx, 1).Value, "\([^\(^\)]*\)")
　　　　Do Until ans = ""
　　　　　Cells(idx, jdx + 2).Value = ans
　　　　　jdx = jdx + 1
　　　　　ans = spfind
　　　　　Loop
　　　　End If
　　 Next idx
　 Set regex = Nothing
End Sub
'=====================================================================
Function spfind(Optional chkstr = "", Optional fstr = "") As String
　 Static matches As Object
　 Static cnt As Long
　 spfind = ""
　 With regex
　　　If chkstr <> "" Then
　　　　 Set matches = Nothing
　　　　 .Pattern = fstr
　　　　 .IgnoreCase = True
　　　　 .Global = True
　　　　 Set matches = .Execute(chkstr)
　　　　 cnt = 0
　　　　 End If
　　 If cnt < matches.Count Then
　　　　spfind = matches(cnt)
　　　　cnt = cnt + 1
　　　　End If
　　 End With
End Function

これでアクティブシートのＡ列の()「（）も含む」内を抜き出して
Ｂ列以降に記述します。

尚、検索対象の()は、半角です。

0 hits

▼

【31620】文字の抽出からコピー 超ビギナー 05/11/27(日) 13:32