| |
▼しん さん：
こんにちは。
いくつか訂正もかねて全部掲載します。
まず、
>A02A02B12B13C22C22C23C2A02B13D345A02E99C2
↑こっちの文字列の方です。
'============================================================
Sub test()
Dim co As Collection
Dim ans() As String
Call 文字列分解(Range("e1").Value, ans())
Set co = mk_unique_collection(ans()) '重複なしの集合体の作成
For idx = 1 To co.Count
cnt = get_abs_count(ans(), co.Item(idx)) '個数の計算ではなく、数える
Cells(idx, 1).Value = co.Item(idx)
Cells(idx, 2).Value = cnt
Next
Set co = Nothing
End Sub
'====================================================================
Sub 文字列分解(strng, a_array() As String)
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() As String)
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
'===============================================================
Function get_abs_count(myarray() As String, pat As String)
get_abs_count = 0
For idx = LBound(myarray) To UBound(myarray)
If myarray(idx) = pat Then get_abs_count = get_abs_count + 1
Next idx
End Function
ほとんど変更はありませんが、変数の型宣言をちゃんと記述しました。
実は､そうしないと次のカンマ区切りの文字列を解析しようすると
プロシジャーの共有ができない・・・、何のために分割してるか
わからなくなってしまうので・・・・。
次に
>CCQM-K13,CCQM-K13,CCQM-K2,CCQM-K28,CCQM-K31,CCQM-K25,CCQM-K25,CCQM-K8,CCQM-K8,CCQM-K8,CCQM-K8,CCQM-K29,CCQM-K29,CCQM-K17,CCQM−K9
のようなカンマ区切りの文字列のコードです。
'====================================================================
Sub test2()
Dim co As Collection
Dim ans() As String
ans() = Split(Range("e1").Value, ",") 'これはVBAの関数
Set co = mk_unique_collection(ans()) '重複なしの集合体の作成
For idx = 1 To co.Count
cnt = get_abs_count(ans(), co.Item(idx)) '個数の計算ではなく、数える
Cells(idx, 1).Value = co.Item(idx)
Cells(idx, 2).Value = cnt
Next
Set co = Nothing
End Sub
testと同様にセルE1に解析文字列を入れて実行してみて下さい。
又、問題があったら教えて下さいね！！
|
|
ichinose
- 04/6/3(木) 18:41 -
