Dictionaryオブジェクトも便利そうですね。。

仕事で，データに対し，ある項目それぞれのアイテム数がほしいときとかあります。

重複無しのデータをさっと作って，それぞれの項目数がほしいなぁとか考える。

重複無しのデータかぁ　ちょいめんどいなぁと思って，シンプルに作る方法をネットで検索してみると，

なんかそれっぽいのがありました。

oshiete.goo.ne.jp

とてもとても短いコードだけど，なんかできるふうに書いてある。

でも・・

なんかうまくいかない。(;´▽｀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

こんな感じで呼び出して使えそうかな。