VBスクリプトで未知の文字列を集計したい場合

質問

以下にプログラムの例と実行結果表示を記します。

2行目 " " 内に決まった（すでにわかっている）文字列を手入力するのではなく、

未知の文字列を区切り文字列で代入したい場合、どのようにすればよいのでしょうか？

例えば、ある図面から抽出した幾つかの文字列を" "内に入れたい場合。

無理である場合、他に手段があればご教示ください。

--------------------------------------------------------------------------------
Dim srcText
srcText = "N41 N41 N41 N41 N41 N43 N43 N43 N45 F03"
'Scripting.Dictionaryで集計
Dim srcTextArray
Dim dic
Dim result
Dim i
Dim ky
srcTextArray = Split(srcText, " ")
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(srcTextArray)
If Not dic.Exists(srcTextArray(i)) Then
dic.Add srcTextArray(i), 1
Else
dic.item(srcTextArray(i)) = dic.item(srcTextArray(i)) + 1
End If
Next
For Each ky In dic.Keys
result = result & ky & " " & dic.item(ky) & vbCrLf
Next
MsgBox result '結果表示
------------------------------------------------------------------------------
以下、実行結果表示

N41 5
N43 3
N45 1
F03 1

回答No.6

n-jun · ベストアンサー

n-junです。

Dictionaryオブジェクトの位置を変えてみました。
ただ気になるのが
＞srcTextArray = Split(srcText, " ")
ですが配列：Arrの文字列は" "を含んでおり、それを区切る必要がありますか？

Dim Acad 'Acad変数宣言
Dim clip 'クリップボードにコピーする文字列
Dim str '文字列を連結するための一時文字列
Dim srcTextArray
Dim dic
Dim result
Dim i
Dim ky
Call TableCopy 'メインプロシージャ呼び出し

'メインプロシージャ
Sub TableCopy()
'AcadRemocon作成
Set Acad = CreateObject("AcadRemocon.Body")
'Dictionaryオブジェクト作成
Set dic = CreateObject("Scripting.Dictionary")

'図形選択→DXFファイル書き出し→線分抽出
If Not Acad.acDxfOut("文字列を一括選択", "", False) Then Er: Exit Sub
If Not Acad.DxfExtract(Cnt, Arr, "ENTITIES", "", "TEXT", "10|20|1") Then Er: Exit Sub
If Cnt < 1 Then Exit Sub

'文字列連結
clip = "": str = Arr(3, 1) 'clipを初期化し、strに最初の文字列を格納する

'dicへ最初の文字列をセット
dic(Arr(3, 1)) = 1

For i = 1 To UBound(Arr, 2) - 1
'dicへ２番目以降の文字列をセット
dic(Arr(3, i + 1)) = dic(Arr(3, i + 1)) + 1

'Y座標が変化したら、行を変えるために分岐する
If Abs(CSng(Arr(2, i)) - CSng(Arr(2, i + 1))) < ROW_ERROR Then
str = str & Arr(3, i + 1) '同一行の場合、文字列を連結する
Else
clip = clip & str '次の行の場合、strをclipに連結する
str = Arr(3, i + 1) 'strに次の文字列を格納する
End If
Next
clip = clip & str '最後の行をclipに連結する

'クリップボードにコピー
Acad.SetClipboardText clip

'Scripting.Dictionaryで集計
For Each ky In dic.Keys
result = result & ky & " " & dic.Item(ky) & vbCrLf
Next
MsgBox result '結果表示
End Sub

AutoCADがないのでテストは出来ませんが、取得する配列：Arrの文字列毎のカウントと
思い、コードに手を加えてみました。

ご参考になればいいのですが。

お礼

成功です。

n-junさんのプログラムは完璧でした。

本当にありがとうございました。

感謝してもしきれないくらいです。

またわからない事を教えてください。

回答No.5

n-jun

n-junです。

＞INPUTBOXからの入力や、TEXTから読み込む方法も試しましたが、どちらも最後の区切り文字列の後ろに"1"が表示され失敗に終わりました。
＞"ScriptingDictionary"の使い方を根本的に間違えていると思うので、調べてみて、もう少し粘ってみます。
最後の区切り文字列の後ろの"1"と言うのが不明ですが、Dictionaryオブジェクトよりも
区切り方の問題ではないかと。

例えば区切り文字を置換で別の文字に変えた時、元の文字列がどう変化するか
確認するのも手かと思います。
置換がおかしければ、区切りの仕方がおかしいと検証できそうです。

補足

ご回答ありがとうございます。

n-junさんが言われた通り、区切りの問題のようです。

Dictionaryオブジェクトで集計する直前の文字列を、デキストに貼り付けてみたところ、区切がでたらめでした。

集計前の区切りを一度全て取って、考え直してみます。

下記にプログラムを貼り付けますので、もしよろしければアドバイスをお願いします。

尚、このプログラムはAutoCADで作成した図面から文字列を抽出し、Dictionaryで集計してクリップボードに貼り付けるものです。

--------------------------------------------------------------------------------------
Dim Acad 'Acad変数宣言
Dim clip 'クリップボードにコピーする文字列
Dim str '文字列を連結するための一時文字列
Dim srcTextArray
Dim dic
Dim result
Dim i
Dim ky
Call TableCopy 'メインプロシージャ呼び出し

'メインプロシージャ
Sub TableCopy
'AcadRemocon作成
Set Acad = CreateObject("AcadRemocon.Body")

'図形選択→DXFファイル書き出し→線分抽出
If Not Acad.acDxfOut("文字列を一括選択", "", False) Then Er: Exit Sub
If Not Acad.DxfExtract(Cnt, Arr, "ENTITIES", "", "TEXT", "10|20|1") Then Er: Exit Sub
If Cnt < 1 Then Exit Sub

'文字列連結
clip = "": str = Arr(3,1) 'clipを初期化し、strに最初の文字列を格納する
For i = 1 To UBound(Arr, 2) -1
'Y座標が変化したら、行を変えるために分岐する
If Abs(CSng(Arr(2,i)) - CSng(Arr(2,i+1))) < ROW_ERROR Then
str = str & Arr(3,i+1) '同一行の場合、文字列を連結する
Else
clip = clip & str '次の行の場合、strをclipに連結する
str = Arr(3,i+1) 'strに次の文字列を格納する
End If
Next
clip = clip & str '最後の行をclipに連結する

'クリップボードにコピー
Acad.SetClipboardText clip

'Scripting.Dictionaryで集計

srcTextArray = Split(clip," ")
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(srcTextArray)
If Not dic.Exists(srcTextArray(i)) Then
dic.Add srcTextArray(i), 1
Else
dic.item(srcTextArray(i)) = dic.item(srcTextArray(i)) + 1
End If
Next
For Each ky In dic.Keys
result = result & ky & " " & dic.item(ky) & vbCrLf
Next
MsgBox result '結果表示
End Sub

回答No.4

n-jun

n-junです。

何となく思ったのが、変数：clip に値を連結させるループ内でDictionaryオブジェクトに
Arr(3,i+1)の値を放り込んでいっても良いのかなって・・・。

何となくなので。

回答No.3

n-jun

＃２です。

Dim v, vv, st, st1
Dim myDic, myKey

Set myDic = CreateObject("Scripting.Dictionary")

st = "aaa" & vbTab & "bbb" & vbTab & "ccc" & vbCrLf _
& "ccc" & vbTab & "bbb" & vbCrLf _
& "fff" & vbTab & "aaa"

st1 = ""

For Each v In Split(st, vbCrLf)
For Each vv In Split(v, vbTab)

myDic(vv) = myDic(vv) + 1

Next
Next

For Each myKey In myDic.keys
st1 = st1 & mykey & "__" & myDic(mykey) & vbCrLf
Next

MsgBox st1

こちらの方が参考になるでしょうか。

お礼

ご回答ありがとうございました。

決まった文字列を" "内に手入力して実行すると、縦1列の配列で横に重複した個数を表示させることができましたが、

まだ、プログラムによる自動入力ができません。

INPUTBOXからの入力や、TEXTから読み込む方法も試しましたが、どちらも最後の区切り文字列の後ろに"1"が表示され失敗に終わりました。

"ScriptingDictionary"の使い方を根本的に間違えていると思うので、調べてみて、もう少し粘ってみます。

回答No.2

n-jun

＃１です。

AutoCADもわかんないのですが、
変数：clipって
＞If Abs(CSng(Arr(2,i)) - CSng(Arr(2,i+1))) < ROW_ERROR Then
＞str = str & vbTab & Arr(3,i+1) '同一行の場合、タブ区切りで文字列を連結する
＞Else
＞clip = clip & str & vbCrLf '次の行の場合、strをclipに連結する
＞str = Arr(3,i+1) 'strに次の文字列を格納する
＞End If
vbCrLf　か　vbTab　で区切れるものであって

＞srcTextArray = Split(srcText, " ")
" "で区切るのがよく分からない感じがします。

vbCrLf で区切って配列にしたものを、順次　vbTab　で区切りDictionaryに入れていくように
思えるのですけど・・・違うかな？

例えば、
Dim v, vv, st, st1

st = "aaa" & vbTab & "bbb" & vbTab & "ccc" & vbCrLf _
& "ddd" & vbTab & "eee" & vbCrLf _
& "fff" & vbTab & "zzz"

st1 = ""

For Each v In Split(st, vbCrLf)
For Each vv In Split(v, vbTab)

st1 = st1 & vv & vbCrLf

Next
Next

MsgBox st1

変数：vvには　vbTab　と vbCrLf　とで区切られた単語が取得できていますが、
これをDictionaryオブジェクトに入れていけばいいのでは？

回答No.1

n-jun

＞ある図面から抽出した幾つかの文字列
これがどこにあるのかですけど。
集計したい対象がどのような状態なのかが重要かと。

例えばどこに作るべきかというのなら、テキストファイルに書き込んでいって、
集計時にテキストファイルから読み込んで上記作業を行なうとか？

ＶＢＳはちょい経験不足ですけどね。

補足

ご回答ありがとうございます。

上記のプログラムは、全プログラム中の集計部分のみです。

下記に、全プログラムを貼り付けします。

集計したい対象の文字列は、下記プログラム中の"clip"に縦1列で格納されています。

尚、このプログラムはAutoCADで作成した図面から文字列を抽出し、クリップボードに貼り付けるプログラムです。

--------------------------------------------------------------------------
Dim Acad 'Acad変数宣言
Dim clip 'クリップボードにコピーする文字列
Dim str '文字列を連結するための一時文字列
Dim srcText
Dim srcTextArray
Dim dic
Dim result
Dim i
Dim ky
Call TableCopy 'メインプロシージャ呼び出し

'メインプロシージャ
Sub TableCopy
'AcadRemocon作成
Set Acad = CreateObject("AcadRemocon.Body")

'図形選択→DXFファイル書き出し→線分抽出
If Not Acad.acDxfOut("文字列を一括選択", "", False) Then Er: Exit Sub
If Not Acad.DxfExtract(Cnt, Arr, "ENTITIES", "", "TEXT", "10|20|1") Then Er: Exit Sub
If Cnt < 1 Then Exit Sub

'文字列連結
clip = "": str = Arr(3,1) 'clipを初期化し、strに最初の文字列を格納する
For i = 1 To UBound(Arr, 2) -1
'Y座標が変化したら、行を変えるために分岐する
If Abs(CSng(Arr(2,i)) - CSng(Arr(2,i+1))) < ROW_ERROR Then
str = str & vbTab & Arr(3,i+1) '同一行の場合、タブ区切りで文字列を連結する
Else
clip = clip & str & vbCrLf '次の行の場合、strをclipに連結する
str = Arr(3,i+1) 'strに次の文字列を格納する
End If
Next
clip = clip & str & vbCrLf '最後の行をclipに連結する

'クリップボードにコピー
Acad.SetClipboardText clip

srcText = clip
'Scripting.Dictionaryで集計

srcTextArray = Split(srcText, " ")
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(srcTextArray)
If Not dic.Exists(srcTextArray(i)) Then
dic.Add srcTextArray(i), 1
Else
dic.item(srcTextArray(i)) = dic.item(srcTextArray(i)) + 1
End If
Next
For Each ky In dic.Keys
result = result & ky & " " & dic.item(ky) & vbCrLf
Next
MsgBox result '結果表示
End Sub