Excel2013のvbaでDictionaryオブジェクトで判定格納と一致後の出力動作

Question

こんにちは。
Excel2013のvbaで今回Dictionaryオブジェクトを初めて使おうとしていますが、分からない所があり、ご教授いただければと思っています。
まず、H1:H3に値が入っていて、その右のI1:I3に"○"か"×"が入力されています。
また、A1:F1にも値が入っています。
やりたいことは、例えばI1に"○"が入ってI2:I3は"×"であれば、"○"のH1の値をDictionaryオブジェクトに登録し、さらにA1:F1の中に一致する値が入っていればその列を非表示にするということをやりたいと考えています。画像であれば、C列とF列を非表示にしたいということです。

一応ある程度作成し、これでいけるかどうかは分かりませんが、あと2か所ほど判定ができれば実現できるのではないかと思っていますが、下のコードのコメントを入れている2か所の判定をどのように書けば宜しいかご教授お願いします。

Sub sample()

Dim c As Range
Dim i As Long
Dim Rr As Range
Dim buf As String

Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

'配列を作成
For Each c In Range(Cells(1, 8), Cells(3, 8))
    Dic.Add c.Value, c.Offset(0, 1).Value
        If Not Dic.Exists(buf) Then 

　　　’まずはここで"○"になっているものだけ格納したい
           Dic.Add buf, buf    
    
        End If
Next c

For Each Rr In Range(Cells(1, 1), Cells(1, 6))
        
       ’ここでDicに格納されている値と Rr.Valueが一致していたら列非表示にしたい
        Rr.EntireColumn.Hidden = True

Next Rr

Set Dic = Nothing

End Sub

tatsu99 · Accepted Answer

あなたの提示されたマクロに追加修正しました。
非表示にした列は、次回にマクロを実行した時、一旦、表示に戻す必要がありますので、それも追記しました。
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
Sub sample()

Dim c As Range
    Dim i As Long
    Dim Rr As Range
    Dim buf As String

Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")

'配列を作成
    For Each c In Range(Cells(1, 8), Cells(3, 8))
        'Dic.Add c.Value, c.Offset(0, 1).Value
        buf = c.Value
        If c.Offset(0, 1).Value = "○" Then
            If Not Dic.exists(buf) Then
                'まずはここで"○"になっているものだけ格納したい
                Dic.Add buf, True
            End If
        End If
    Next c

For Each Rr In Range(Cells(1, 1), Cells(1, 6))
        Rr.EntireColumn.Hidden = False          '前回の非表示を解除
        If Dic.exists(Rr.Value) = True Then
            'ここでDicに格納されている値と Rr.Valueが一致していたら列非表示にしたい
            Rr.EntireColumn.Hidden = True
        End If
    Next Rr

Set Dic = Nothing

End Sub

WindFaller · Answer

No.2の回答者です。

>これはこの前に何か他で使用していたことを想定してですか？通常は、終わってから入れるものだと思うのですが。

私の説明ではお気づきにならなかったようですね。そもそもの問題なのですが、登録したものを毎度毎度書き換えるというのは少し変だと思ったからです。頻繁に行うなら、Dictionary のような外部オブジェクトは使う必要はあまりありません。一般のワークシート関数で十分だからです。

これが私の本来のコードです。
ただし、Dic オブジェクトがどのぐらいの耐久性があるのか分かりません。エラーを出したら壊れます。
'--------------------------
'//分離した場合
Private Dic As Object 'モジュールスコープ
Sub MakingDictinary() '上記のオブジェクトが壊れていない限りは、同じ辞書が使えます。
Dim c
Set Dic = Nothing 'これが更新用のNothingです。
Set Dic = CreateObject("Scripting.Dictionary")
　For Each c In Range("H1", Cells(Rows.Count, 8).End(xlUp))
　  If Not Dic.Exists(c.Value) Then
　　Dic.Add c.Value, Trim(c.Offset(, 1).Value)
　  End If
　Next
End Sub
Sub HiddenColwithDicOrg() '通常は、こちらだけで良い。
  Dim c As Variant
  If Dic Is Nothing Then MsgBox "辞書がありません。", vbCritical: Exit Sub
  For Each c In Range("A1").Resize(, 6)
　If Dic.Exists(c.Value) Then
　  If Dic.Item(c.Value) = "○" Then '非表示(変更)
　　c.EntireColumn.Hidden = True
　  Else
　　c.EntireColumn.Hidden = False
　  End If
　End If
  Next
End Sub

tatsu99 · Answer

No2です。
通常はここまで回答しないのですが、No4のかたと同じ感想を持ちましたので追記します。
（大部分の質問者は、マクロで期待する結果が得られればそれでOKなので、このような追記はしません）

Dictionaryにキーと値を登録するときの基準です。
私は以下の様な基準で、行っています。
１．キーのみが必要な場合は、値はTrueを登録する。（今回のケース）

２．キーとその属性のどれかが必要なら、キーとその属性を設定する。
添付図で、社員マスターのシートの氏名をキーとして、年齢が必要なら、氏名（キー）と年齢（値）を登録する。

３．キーとその属性が複数必要なら、キーと行番号を記憶する。
添付図で、社員マスターのシートの氏名をキーとして、年齢、体重、伸長が必要なら、氏名（キー）と行番号（値）を登録する。

登録後、該当キーにマッチする伸長が必要なら
dim gyo as long
gyo = Dic("該当の氏名")
伸長=Worksheets("社員マスター").Cells(gyo,"C").value
のようにします。

原則、Dictionaryの値は１項目しか登録できませんのでこのようにします。
通常はこれで事足ります。

上記以外の方法で、複数項目を登録する方法もいくつかありますが、ここでは省略します。

ママチャリ · Answer

横から失礼します。すでに出ている回答と大差ないのですが、hinoki24さんて意識高そうなので、参考になればと思い、投稿しました。
ポイントとしては、DictionaryオブジェクトのItemプロパティに"〇"を代入しているところです。Itemプロパティへの代入では、Keyが存在していない場合に追加してくれるので、事前の存在判定が不要になります。ただ、同じKeyが複数あった場合、都度、更新されるので、最終的に最後の値が格納されることになります。

Sub sample()
    Dim Dic As Object
    Dim c As Range

'配列を作成
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each c In Range(Cells(1, 8), Cells(3, 8))
        'まずはここで"○"になっているものだけ格納したい
        If c.Offset(, 1).Value = "〇" Then
            Dic.Item(c.Value) = c.Offset(, 1).Value
        End If
    Next c

For Each c In Range(Cells(1, 1), Cells(1, 6))
        '列の表示／非表示を設定する
        c.EntireColumn.Hidden = Dic.Exists(c.Value)
    Next c

Set Dic = Nothing

End Sub

tatsu99 · Answer

No1です。
dic.Add キー,値　
ですが、この状況でのDictionaryの使用は、キーのみが必要であり、値は特に必要としません。
値がなんでも良いため、Trueとしました。

＞If Dic.exists(Rr.Value) = True Then
＞こちらの　True　と関連していますか？
とは、関連しません。

Dic.Add buf, 1
Dic.Add buf, "○"
でも構いません。

今回は、A1～F1の内容が、Dictionaryにあるかどうかだけを判断する為に使用するので、値は特に使用されません。

WindFaller · Answer

おかきになったコードはロジックが読めないですが、
>画像であれば、C列とF列を非表示にしたいということです。
おそらくは、C列とE列とF列の非表示だと思います。
「C列とF列を非表示にしたいということです。」ということであれば、もう一つ、別な条件が必要かと思われます。

私が最初に見た範囲なら、単に、Dictionary オブジェクトを参照し、利用するには、このようにしたら良いかと思います。

>’まずはここで"○"になっているものだけ格納したい
○・×両方を入れました。

'//
Sub HiddenColwithDic()
　Dim c As Variant
　Dim Dic As Object
　Set Dic = Nothing
　Set Dic = CreateObject("Scripting.Dictionary")
　For Each c In Range("H1", Cells(Rows.Count,"H").End(xlUp))
　　If Not Dic.Exists(c.Value) Then
　　　Dic.Add c.Value, Trim(c.Offset(, 1).Value)
　　End If
　Next
'--------------↑辞書登録 ↓列の非表示
　For Each c In Range("A1").Resize(, 6)
　　If Dic.Exists(c.Value) Then
　　　If Dic.Item(c.Value) = "×" Then
　　　　c.EntireColumn.Hidden = True
　　　Else '×や登録のないものは、表示列になる
　　　　c.EntireColumn.Hidden = False
　　　End If
　　End If
　Next
End Sub

------------------------------------------------
これは、辞書の登録と列の非表示は別の作業ですから、本来、分離して使うようにできています。
共通するオブジェクト　Dim Dic Object をモジュールの外に出しておけば、辞書の登録をその都度しなくて済むはずです。

Excel2013のvbaでDictionaryオブジェクトで判定格納と一致後の出力動作

あなたの提示されたマクロに追加修正しました。

No.2の回答者です。

No2です。

横から失礼します。

No1です。

おかきになったコードはロジックが読めないですが、

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング