エクセルVBAで文字列の重複を削除する方法？

質問

VBAでの質問でしゅ。エクセルは2000です。
変数MyStrに全角カンマで区切られた文字列データが１０種類程度あります。
現在、ある条件のもとに、MyStr=MyStr & Cell(i,2)　& "、"のように取り込んで、最後にMyStr=Left(MyStr, Len(MyStr) - 1) で一番最後の「、」を削除しています。

例えば、MyStrの中身は、

OK建設株式会社、Goo工業合資会社、MM商事有限会社、AA合名会社、株式会社BB企画、OK建設株式会社、CC工業合資会社、DD商事有限会社、EE合名会社、株式会社BB企画

のような感じです。この中には重複したデータがある可能性があります。（例ではOK建設株式会社と株式会社BB企画）

これを重複を排除し、変数MyStrの中身を、

OK建設株式会社、Goo工業合資会社、MM商事有限会社、AA合名会社、株式会社BB企画、CC工業合資会社、DD商事有限会社、EE合名会社　

と変える方法はないでしょうか？
あるいは、変数　MyStrにデータを取り込む際にすでにMyStrに入っているデータは除くような方法でもかまいません。

お知恵をお貸しくださいませ。　(o。_。)oペコッ.

回答No.5

Wendy02 · ベストアンサー

こんにちは。

#2 さんの
>素直に配列かなんかを使って重複除去プログラムをまじめに作ったほうがいいかも？

私もそうは思ったのですが、ここの掲示板では、あまりそういう雰囲気にないということと、Excel VBAでは、こういう場合は、本来、AdvancedFilter を使ってしまいます。

あえて、後学のためにこんなコードを披露しておきます。以下のコードは、いろんなコードを十分に検討していればよいのですが、これしかないというようなコードではありません。

なお、本来、Dictionary オブジェクトにセルの値から直接入れればよいです。
今回は、文字列として出来上がっているという条件の下で書きました。

Sub DictionaryMethod()
Dim objDic As Object
Dim myText As String
Dim arData As Variant
Dim i As Long
Dim v As Variant
Dim arOut As Variant
'本来はセルから取る
Const strText = "OK建設株式会社、Goo工業合資会社、MM商事有限会社、AA合名会社、株式会社BB企画、OK建設株式会社、CC工業合資会社、DD商事有限会社、EE合名会社、株式会社BB企画"
　Set objDic = CreateObject("Scripting.Dictionary")

　myText = WorksheetFunction.Substitute(strText, " ", "") '半角空白抜き
　arData = Split(myText, "、")　
　i = 1
　For Each v In arData
　　　If objDic.Exists(v) = False Then
　　　　objDic.Add v, i　'i はダミーです。
　　　　i = i + 1 　
　　　End If
　Next v
　arOut = objDic.Keys

　'出力する方法
　Range("A1").Resize(objDic.Count).Value = WorksheetFunction.Transpose(arOut)
　Set objDic = Nothing
End Sub

お礼

Dictionary オブジェクトですか。
はじめて聞く言葉です。
VBAの呪文は奥が深いのですねえ・・・。

やってみて上手くいきました。
ただ、
> 'i はダミーです。
の意味がわかりません。

> arOut = objDic.Keys
これはobjDicをarOutという配列に取り込んだのですよね？Keysってなんでしょう？

回答No.10

Wendy02

こんにちは。Wendy02です。

>Dictionary オブジェクトですか。
>はじめて聞く言葉です。

でも……。しょせん外部オブジェクトですからね……。（^^;
そんなに使えるものとは思っていません。Excelは、内部にいろいろありますからね。

>> 'i はダミーです。
>の意味がわかりません。

i は、単に、割り振りだけです。それ自体は、ここでは役に立っていませんね。

>> arOut = objDic.Keys
>これはobjDicをarOutという配列に取り込んだのですよね？Keysってなんでしょう？

Dictionary オブジェクトには、Key と Item があって、Key側に名称が入っていますから、それを配列で取り出しました。

Dictionary オブジェクト

参考URL：

http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/script56/html/jsobjdictionary.asp

お礼

ありがとうございます。
輝けるみなさまの足元にも及びませんが、すこしずつ勉強してまいりたいと思っております。

回答No.9

KenKen_SP

こんな感じです。

Collection というオブジェクトがあります。よく、Worksheets
コレクション...といった表現がこのサイトでもでてきますけど、
アレです。

Worksheets は組み込みですが、自分でコレクションを作ること
が可能です。値のほか、オブジェクトも扱うことができますので
使い方の工夫次第で非常に便利ですよ。

今回は、Dictionary と同じような使い方をしましたが、重複判定
処理には Dictionary の方が高速なので、参考情報まででした。

Sub test2()

　　Dim Buf()　　　 As String
　　Dim SourceArray As Variant
　　Dim UniqueArray As Collection
　　Dim vItem　　　 As Variant

　　SourceArray = Split("OK建設株式会社、Goo工業合資会社、MM商事有限会社、AA合名会社、株式会社BB企画、OK建設株式会社、CC工業合資会社、DD商事有限会社、EE合名会社、株式会社BB企画", "、")

　　' // ユニークデータを取り出す
　　Set UniqueArray = New Collection
　　On Error Resume Next
　　For Each vItem In SourceArray
　　　　UniqueArray.Add vItem, vItem
　　Next
　　On Error GoTo 0

　　' // UniqueArray というのは Collection オブジェクトです。
　　' // 配列にするためには、For ループなどで回します。
　　' // Collection は １オリジン（添え字が1から始まる）のに注意
　　ReDim Buf(UniqueArray.Count - 1)
　　For i = 1 To UniqueArray.Count
　　　　Buf(i - 1) = UniqueArray(i)
　　Next

　　' // Join は指定した区切り文字で一次元配列の内容を
　　' // 連結する関数です ※Excel2000以降

　　' // 改行コードで連結する場合
　　MsgBox Join$(Buf, vbCrLf)

End Sub

お礼

ご丁寧にありがとうございました。
まだ消化不良ですが、とても勉強になりました。

回答No.8

KenKen_SP

#7 の記載ミス訂正です。

　　' // 一次元配列から重複を取り除く
　　Set UniqueArray = New Collection
　　On Error Resume Next
　　For Each vItem In SourceArray
　　　　UniqueArray.Add vItem, vItem ' <-- キーの重複不可を利用です
　　Next
　　On Error GoTo 0

お礼

有難うございました。
このようにしてみたのですがうまく行きません。

Sub test2()
SourceArray = Split("OK建設株式会社、Goo工業合資会社、MM商事有限会社、AA合名会社、株式会社BB企画、OK建設株式会社、CC工業合資会社、DD商事有限会社、EE合名会社、株式会社BB企画", "、")
Set UniqueArray = New Collection
On Error Resume Next
For Each vItem In SourceArray
UniqueArray.Add vItem, vItem ' <-- キーの重複不可を利用です
Next
On Error GoTo 0
MsgBox Join(UniqueArray)
End Sub

回答No.7

KenKen_SP

私も参加^^ 　蛇足回答だけどね。。

配列からユニークデータを取り出すなら、定番は Dictionary ですが
Collection を使ってもできますよ。

　　' // 一次元配列から重複を取り除く
　　Set UniqueArray = New Collection
　　On Error Resume Next
　　For Each vItem In SourceArray
　　　　UniqueArray.Add vItem
　　Next
　　On Error GoTo 0

Collection は同一値を Add しようとするとエラーになるのを利用
してます。

回答ですが、処理の流れとしては

1.　前処理として区切り文字となる「、」記号の全半角統一
2.　Split で配列にばらす
3.　必要なら配列要素に Trim などの加工を行う
4.　3 の配列に対し、#3ご回答の方法や上述のような方法でユニーク
　　データを取り出す
5.　4. のデータを配列に戻す
4.　Join で配列を連結する

とかでしょうか。

お礼

ありがとうございました。
せっかく教示いただいたのですが、
4. のデータを配列に戻す　　が、残念ながら出来ませんでした。

回答No.6

kobouzu_su

またまた、kobouzuです。
回答もせずに人の回答云々では、おい、おい、だろうと
ランチ（スパ＆珈琲）を食べた後。。。。と思ってたら
Wendy02さんの回答が出てました。。。(^^;;;
が、折角書いたのでアップップ。

'-----------------------------------------------
Sub Test()
　Dim i As Long
　Dim myStr As String
　Dim myDic

　Set myDic = CreateObject("Scripting.Dictionary")

　For i = 2 To Range("B65536").End(xlup).Row
　　　If myDic.exists(Cells(i, "B").Value) = False Then
　　　　　myStr = myStr & Cells(i, "B").Value & "、"
　　　　　myDic.Add Cells(i, "B").Value, ""
　　　End If
　Next i

　myStr = Left(myStr, Len(myStr) - 1)

End Sub
'-----------------------------------------------------

以上です。

お礼

ありがとうございます。
これもうまく作動します。

> myDic.Add Cells(i, "B").Value, ""
の　,"" はなんでしょうか？
Wendy02さんの、objDic.Add v, i のiに当るのでしょうか？

回答No.4

kobouzu_su

kobouzuです。

daibutsuyoさん、凄い！
InStr(MyStr, "、" & Cell(i,2) & "、")
これは頭の隅にも浮かびませんでした。(^^;;;

それから、先の投稿はdaibutsuyoさんの回答が、云々、というものではありませんので。。。
質問者が色んな場合を想定しているのかどうかの確認のためです。

これからも目から鱗の回答、期待しています。

回答No.3

noname#62235

＃１です。
MyStrの先頭にも"、"をつけるようにして、
判定を

InStr(MyStr, "、" & Cell(i,2) & "、")

にすれば解決できるかな？（会社名には「、」が使われていない前提）

まあ、細かいこと言い出したら、この部分一致判定はザルだらけになる危険性大なので、素直に配列かなんかを使って重複除去プログラムをまじめに作ったほうがいいかも？
面倒だけど。

お礼

ありがとうございます。
前後に”、”あるいは絶対使用されないような文字をつけて判定すれば大丈夫ですね。

回答No.2

kobouzu_su

エキスパートさん、台風の中から（まだですが、、）こんにちは。

またまた老婆心ながらの一言。

＞If (InStr(MyStr, Cells(i, 2)) =0) Then MyStr = MyStr & Cells(i, 2) & "、"
＞取り込まない方法については一発で解決しました！

本当に解決ですか？
文字列によっては拙いことはありませぬか？

例えば、いま、

myStr =　"大山田商会、南鹿児島建設、長野商事"　として

次のデータが、”鹿児島建設”　だとどうでせう。

上手くいきますか？？？

そんな部分一致の会社名はありましぇ～ん、ということであれば無視！

これに限らず、コードを書くときは色んな場合を想定しなければいけません、
と偉そうなことを言ってみる。(^o^)。。。

以上です。

お礼

貴重なご指摘有難うございました！
ありえますね！

南鹿児島建設株式会社と鹿児島建設株式会社　なら頭の違い
有限会社薩摩芋焼酎販売と有限会社薩摩芋焼酎　なら後ろの違いですが　どちらも部分一致してしまいますね！

う～ん。

回答No.1

noname#62235

InStr関数で、MyStr中に今加えようとしている文字列が含まれているかどうかチェックしたらどうでしょうか？

if (InStr(MyStr, Cell(i,2)) > 0) then MyStr=MyStr & Cell(i,2)　& "、"

お礼

'If (InStr(MyStr, Cells(i, 2)) =0) Then MyStr = MyStr & Cells(i, 2) & "、"

ですね。
取り込まない方法については一発で解決しました！
有難うございました。

あとは、既に入ってるものを削除する方法があるのか・・・