| |
▼しん さん：
おはようございます。
>Excelワークシートのあるセルに下記のような任意の文字列データ
>
>A02A02B12B13C22C22C23A02B13D345A02E99
>
>が入っていたとき、この文字列を英文字を先頭にした文字列群に分解し、その個数を文字列名と共に知りたい、すなわち
>
>A02:4, B12:1, B13:2, C22:2, C23:1, D345:1, E99:1
>
>のような解答（文字列データ）を得たいのですが、どのようなVBAコードを書けばいいのでしょうか？
以下の例はアクティブシートのセルE1に上記の
「A02A02B12B13C22C22C23A02B13D345A02E99」等の文字列が入っていた場合、
Ａ列の１行目から「英文字を先頭にした文字列群」Ｂ列の１行目から「個数」を
セットします。
'======================================================================
Sub test()
Dim co As Collection
Dim ans()
Call 文字列分解(Range("e1").Value, ans())
Set co = mk_unique_collection(ans()) '重複なしの集合体の作成
For idx = 1 To co.Count
wk = Filter(ans(), co.Item(idx), , vbTextCompare)
cnt = UBound(wk) - LBound(wk) + 1 '個数の計算
Cells(idx, 1).Value = co.Item(idx)
Cells(idx, 2).Value = cnt
Next
Set co = Nothing
End Sub
'=====================================================================
Sub 文字列分解(strng, a_array())
Dim regEx, Match, Matches ' 変数を作成します。
Set regEx = CreateObject("VBScript.RegExp")
' 正規表現を作成します。
regEx.Pattern = "[A-Za-z][0-9]*"
regEx.IgnoreCase = True ' 大文字と小文字を区別しないように設定します。
regEx.Global = True ' 文字列全体を検索するように設定します。
Set Matches = regEx.Execute(strng) ' 検索を実行します。
idx = 1
For Each Match In Matches ' Matches コレクションに対して繰り返し処理を行います。
ReDim Preserve a_array(1 To idx)
a_array(idx) = Match.Value
idx = idx + 1
Next
Set regEx = Nothing
Set Match = Nothing
Set Matches = Nothing
End Sub
'======================================================================
Function mk_unique_collection(myarray())
Dim myclct As New Collection
On Error Resume Next
For idx = LBound(myarray()) To UBound(myarray())
myclct.Add myarray(idx), myarray(idx)
Next
Set mk_unique_collection = myclct
Set myclct = Nothing
On Error GoTo 0
End Function
これでプロシジャー「test」を実行してみて下さい。
Ａ列Ｂ列の１行目から、
A02 4
B12 1
B13 2
C22 2
C23 1
D345 1
E99 1
という結果が得られました。
確認してみて下さい。
|
|
ichinose
- 04/6/2(水) 7:46 -
