Dictionaryオブジェクトも便利そうですね。。
仕事で,データに対し,ある項目それぞれのアイテム数がほしいときとかあります。
重複無しのデータをさっと作って,それぞれの項目数がほしいなぁとか考える。
重複無しのデータかぁ ちょいめんどいなぁと思って,シンプルに作る方法をネットで検索してみると,
なんかそれっぽいのがありました。
とてもとても短いコードだけど,なんかできるふうに書いてある。
でも・・
なんかうまくいかない。(;´▽`A``未熟だなぁ。
こんなふうにやってみました。
コードを真似させてもらって,
Sub Test() Dim SourceData As Variant Dim TargetSheet As Worksheet: Set TargetSheet = Worksheets(1) Dim c Dim Db As Object SourceData = TargetSheet.Range("a1:a19").Value Set Db = CreateObject("Scripting.Dictionary") For Each c In SourceData Db(c) = 1 'セル値をキーにして重複分を吸収 Next c Dim ResultData As Variant ResultData = Db.keys '新配列の展開 Stop TargetSheet.Range("c1").Resize(Db.Count, 1).Value = ResultData End Sub
短くていいですね。宣言が無かったらかなり短い
ローカルウィンドウを見て,うんうん うまく取れてる
なんで!!?
むーーー。職場で朝やったときはちゃんとできたのに何が違うのか・・
明日使いたいのになぁ。もうちょい考えてみよう・・。
追記です。 imihitoさんから極めて的確なアドバイスをいただきました。
ほんと,おっしゃる通りで,横方向に出力すると,簡単に出力された。
アドバイスを反映し,短さを求めてここではあまりオブジェクト変数を使わずに書いてみた
Sub Test() Dim Db As Object, c Set Db = CreateObject("Scripting.Dictionary") For Each c In Worksheets(1).Range("a1:a19").Value Db(c) = 1 Next c Worksheets(1).Range("c1").Resize(Db.Count, 1).Value = WorksheetFunction.Transpose(Db.keys) End Sub
実際にはワークシートとか値の範囲は引数で与えるとすっきりしますね。
これは短い。
ちゃんと
この短さでも的確な仕事をしています。
これはイイ。明日早速使わせてもらおう。うれしいなぁ。
Sub Test() Dim TargetSheet As Worksheet: Set TargetSheet = Worksheets("Sheet1") Call 重複除去(TargetSheet.Range("a1").CurrentRegion, TargetSheet.Range("c1")) End Sub Sub 重複除去(元データ As Range, 貼付先 As Range) Dim Db As Object, c: Set Db = CreateObject("Scripting.Dictionary") For Each c In 元データ.Value Db(c) = 1 Next c 貼付先.Resize(Db.Count, 1).Value = WorksheetFunction.Transpose(Db.keys) End Sub
こんな感じで呼び出して使えそうかな。