| |
おはようございます。
>列Aに
>Aaa bbb (25A, 45A) ccc ddd, eee (261) fff (7, 44, 47).
>
>とある場合に()間の文字を
>列B 列C 列D 列E 列F 列G・・・
>25A 45A 261 7 44 47
>
>といったように抜き出したいと思っています。
正規表現を使ってみました。
標準モジュールに
'========================================================================
Sub test()
Dim rng As Range
Dim ele1 As Variant
Dim result As Variant
Dim crng As Range
Dim pat As String
Dim wk As Variant
Dim g0 As Long
Dim ele2 As Variant
Set rng = Range("a1", Cells(Rows.Count, "a").End(xlUp))
pat = "\([^(\(|\))]+\)"
For Each crng In rng
result = mymatches(crng.Value, pat)
If TypeName(result) <> "Boolean" Then
Dim distarray()
g0 = 1
For Each ele1 In result
wk = Split(Mid(ele1, 2, Len(ele1) - 2), ",")
For Each ele2 In wk
ReDim Preserve distarray(1 To g0)
distarray(g0) = ele2
g0 = g0 + 1
Next
Next
crng.Offset(0, 1).Resize(, UBound(distarray())).Value = distarray()
Erase distarray()
End If
Next
Set rng = Nothing
Set crng = Nothing
End Sub
'=============================================================
Function mymatches(strng As Variant, pat As Variant) As Variant
Dim regEx, Match, Matches
Dim g0 As Long
Dim ans() As Variant
Set regEx = CreateObject("VBScript.RegExp")
' 正規表現を作成します。
regEx.Pattern = pat
regEx.IgnoreCase = True ' 大文字と小文字を区別しないように設定します。
regEx.Global = True ' 文字列全体を検索するように設定します。
Set Matches = regEx.Execute(strng) ' 検索を実行します。
g0 = 1
ReDim ans(1 To Matches.Count)
For Each Match In Matches
ans(g0) = Match.Value
g0 = g0 + 1
Next
If Matches.Count > 0 Then
mymatches = ans()
Else
mymatches = False
End If
Set regEx = Nothing
Set Match = Nothing
Set Matches = Nothing
Erase ans()
End Function
アクティブシートのＡ列1行目から、
Aaa bbb (25A, 45A) ccc ddd, eee (261) fff (7, 44, 47).
このようなデータが入っているとすると、
上記testを実行してみてください。
|
|
ichinose
- 10/6/29(火) 5:25 -
