シート間のコピー_3(VBA研究会議事録_10)

VBA研究会で論じられた内容を記録する議事録の10本目(2023/03/25開催分)です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

前回も引き続きシート間のコピーについて、取り組みました。

そして今回も続きです。さらに条件を追加してみました。

今回は @FukucyndiP さんのコードを中心に掲載します。

範囲を指定したコピー_3

それでは今回のお題です。

Worksheet_Changeイベントを使って以下の処理を実行するコードを作成してください

  • Sheet1の任意の位置に任意の値を入力する
  • Sheet1のA-C列の値のみSheet2のA列にコピーする
  • コピーする値は重複していないもののみとする
  • 順序は不問とする

イメージにすると、こんな感じです。図にするとわりやすいですね。

実際のコード

実際のコードをご紹介します。今回のコードはDictionaryオブジェクト(連想配列)を使用しています。事前バインディングを使用していますので、Microsoft Scripting RuntimeをVBEの「ツール」→「参照設定」で「Microsoft Scripting Runtime」にチェックを入れてください。

Worksheet_Changeイベント

まずはWorksheet_Changeイベントのコードから。

'値を入力するシートモジュールに記述する
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim 転記対象範囲 As Range
    Set 転記対象範囲 = Me.Range("A:C")
    
    Sheet2.UsedRange.ClearContents
    If Application.Intersect(Target, 転記対象範囲) Is Nothing _
       Or WorksheetFunction.CountA(転記対象範囲) = 0 Then
        Exit Sub
    Else
        Call 値の転記
    End If
End Sub

まずはTargetで取得した入力範囲がA-C列かを判定します。またCountAを使用してA-C列の値の有無を判定しています。入力された値がA-C列内の場合は「値の転記」処理を行います。

値の転記

Sub 値の転記()
    '値が入力されているセルを一括で取得して重複を削除しつつ値を辞書に登録する
    Dim 値があるセル達 As Variant
    Set 値があるセル達 = Me.Range("A:C").SpecialCells(xlCellTypeConstants)
    
    Dim dic As Dictionary: Set dic = New Dictionary
    Dim tempCell As Range
    For Each tempCell In 値があるセル達
        If Not dic.Exists(tempCell.Value) Then
            Call dic.Add(tempCell.Value, Null)
        End If
    Next
    
    'Sheet2のA1セルから縦に出力する
    Call 配列をデータを出力(Sheet2.Range("A1"), dic.Keys)
End Sub

「Me.Range("A:C").SpecialCells(xlCellTypeConstants)」で値のあるセルのみを選択しています。この時値のあるセルがないとエラーになってしまうので、上記のプロシージャで値の有無を確認しています。次に値のあるセルの値のみDictionaryオブジェクト「dic」に登録しています。この時登録されるのは、Existsメソッドで事前に登録されていないことを確認したもののみです。

Dictionaryオブジェクトにデータを追加する場合は以下の様に記述します。

Dictionaryオブジェクト.Add キー, 要素

今回はキーのみを使用するので要素部分は「Null」を指定します。完了したら、表示場所の先頭(Sheet2のA1)とデータ(「dic」のkeysコレクション)を指定して出力します。

実際の出力

実際の主力です。

Sub 配列をデータを出力(ByVal Target As Range, ByVal arr As Variant)
    
    Dim i As Long: i = 0
    Dim tempVal As Variant
    For Each tempVal In arr
        Target.Offset(i, 0).Value = tempVal
        i = i + 1
    Next
End Sub

データ(「dic」のkeysコレクション)をバリアント型の配列で受け取って、指定された場所に順次表示します。

次回は実践版

いかがでしたでしょうか。Dictionaryオブジェクトは便利ですね!!個人的に使いこなせていないのでこの機会に学んでいきたいと思います!! 次回はここまで学んだことを踏まえて実践形式の課題に取り組みます。お楽しみに!!

hirocom777.hatenadiary.org

VBA研究会議事録まとめはこちらから