39本目：数値リストの統合（マージ）

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：数値リストの統合（マージ）

#VBA100本ノック 39本目
A列とB列の数値を統合（マージ）しユニーク化してC列に出力します。
・A列、B列ともに行数は不定
・列内では数値は昇順になっています。
・列内では重複していないが、A列とB列では重複します。
・C列へは重複しない数値として昇順に出力してください。
※画像を参考に。

◇ 出題ページはこちら

本解答は以下の3つを用意しました。

• スピル数式を利用したバージョン
• 重複削除をDictionaryで行ったバージョン
• 本問に沿ったロジックを構築したバージョン

お好きな解答をご参考ください。

スピル数式バージョン

メインモジュール

Option Explicit

' 100本ノック039：数値リストの統合（マージ）
Sub 数値リストをマージする_スピル活用版()
    With WSリスト
        
        .Columns("C").Delete
        .Range("C1").Formula2 = "=SORT(UNIQUE(VSTACK(A:.A,B:.B)))"
        .Range("C1#").Value = .Range("C1#").Value
        
    End With
End Sub

解説

本問題はExcel新関数群がぴったりはまる問題でした。

解答に使っている機能は以下の通りです。

• 動的にデータ数が変わることへの対応 - TRIM演算子「:.」
• セル範囲を配列として縦に重ねる - VSTACK関数
• 重複を削除する - UNIQUE関数
• 配列をソートする - SORT関数
• 計算結果でスピルしている範囲を取得する - スピル範囲演算子「#」

これらの基本的な使い方がつまった良い問題でしたね。

Excel365ユーザーであれば、長いVBAコードを書かなくても、
新関数とスピルの組み合わせでかなりの処理を書くことが可能です。

本問の通り圧倒的に少ないコード量でマクロを作れますので、
まずはこの手法が使えないかを模索してマクロを作りはじめましょう。

Dictionaryによる重複削除バージョン

メインモジュール

Sub 数値リストをマージする_Dictionary版()
    With WSリスト
        
        .Columns("C").Delete
        
        Dim Dic数値リスト As Dictionary
        Set Dic数値リスト = セル範囲から重複を無くしたDictionaryを生成(.Columns("A:B"))

        Call 一次元配列をセルに出力する(.Range("C1"), Dic数値リスト.Keys)
        
        .Range("C1").Resize(Dic数値リスト.Count).Sort .Range("C1")
        
    End With
End Sub

汎用関数モジュール

' Dictionaryによる重複削除
Function セル範囲から重複を無くしたDictionaryを生成(セル範囲 As Range, Optional is空白は無視 As Boolean = True) As Dictionary

    Dim Dic結果値 As New Dictionary
    Set セル範囲から重複を無くしたDictionaryを生成 = Dic結果値
    
    ' 行全体・列全体を渡しても処理速度が低下しないようUsedRangeでカット
    Dim ForEach範囲 As Range
    Set ForEach範囲 = Intersect(セル範囲, セル範囲.Worksheet.UsedRange)
    If ForEach範囲 Is Nothing Then Exit Function
    
    ' 各値をkeyとしてDictionaryに格納
    Dim セル As Range
    For Each セル In ForEach範囲.Cells

        If セル.Value <> "" Or is空白は無視 = False Then
            
            If Dic結果値.Exists(セル.Value) = False Then
                Dic結果値.Add セル.Value, Empty
            End If
            
        End If

    Next

End Function

' 一次元配列 → セル
' 参考：https://www.limecode.jp/entry/utility/output-array-to-range
Sub 一次元配列をセルに出力する(出力始点セル As Range, Arr出力配列 As Variant _
    , Optional is縦方向へ出力 As Boolean = True)

    Dim 要素数 As Long: 要素数 = Count配列の要素数(Arr出力配列)
    If is縦方向へ出力 Then
        出力始点セル.Resize(要素数, 1).Value _
            = GetArray一次元配列→n行1列の二次元配列(Arr出力配列)
    Else
        出力始点セル.Resize(1, 要素数).Value = Arr出力配列
    End If
    
End Sub

' 配列の要素数の取得
' 参考：https://www.limecode.jp/entry/syntax/ubound-lbound-count-array-elemens
Function Count配列の要素数(Arr, Optional 次元 = 1) As Long
    Count配列の要素数 = UBound(Arr, 次元) - LBound(Arr, 次元) + 1
End Function

' Transpose上限対応用関数
' 参考：https://www.limecode.jp/entry/utility/output-array-to-range
Function GetArray一次元配列→n行1列の二次元配列(Arr As Variant) As Variant
    
    Dim 生成配列()
    ReDim 生成配列(LBound(Arr) To UBound(Arr), 1 To 1)
    
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        生成配列(i, 1) = Arr(i)
    Next
    
    GetArray一次元配列→n行1列の二次元配列 = 生成配列
    
End Function

解説

続いてDictionaryによる重複削除を利用した解答です。

DictionaryをKeyだけの一次元配列として使うことで、
存在判定や重複削除を効率よく処理できる配列として使用できます。

このコードは単純故に毎回同じようなコードを書くことになりますので、
本解答のように汎用関数にしておきましょう。

スピル式活用時と同じレベルでメインコードを簡潔に書くことが可能です。

本問用のロジックバージョン

メインモジュール

' 100本ノック039：数値リストの統合（マージ）
Sub 数値リストをマージする_ロジック版()
    With WSリスト
        
        .Columns("C").Delete
        
        Dim A列の次の候補 As Range: Set A列の次の候補 = .Range("A1")
        Dim B列の次の候補 As Range: Set B列の次の候補 = .Range("B1")
        Dim C列の次の出力先 As Range: Set C列の次の出力先 = .Range("C1")

        Do
            
            ' どちらも取り切ったらExit
            If A列の次の候補.Value & B列の次の候補.Value = "" Then
                Exit Sub
                
            ' どちらかが空欄ならもう片方を出力
            ElseIf A列の次の候補 = "" Then
                C列の次の出力先.Value = B列の次の候補.Value
                Set B列の次の候補 = B列の次の候補.Offset(1)
                Set C列の次の出力先 = C列の次の出力先.Offset(1)
                
            ElseIf B列の次の候補 = "" Then
                C列の次の出力先.Value = A列の次の候補.Value
                Set A列の次の候補 = A列の次の候補.Offset(1)
                Set C列の次の出力先 = C列の次の出力先.Offset(1)
                
            ' どちらも同じ値ならC列に出力してどちらの候補も次に進める
            ElseIf A列の次の候補 = B列の次の候補 Then
                C列の次の出力先.Value = A列の次の候補.Value
                Set A列の次の候補 = A列の次の候補.Offset(1)
                Set B列の次の候補 = B列の次の候補.Offset(1)
                Set C列の次の出力先 = C列の次の出力先.Offset(1)
            
            ' A列とB列で小さい方をC列に出力して候補を次に進める
            ElseIf A列の次の候補 < B列の次の候補 Then
                C列の次の出力先.Value = A列の次の候補.Value
                Set A列の次の候補 = A列の次の候補.Offset(1)
                Set C列の次の出力先 = C列の次の出力先.Offset(1)
            
            Else
                C列の次の出力先.Value = B列の次の候補.Value
                Set B列の次の候補 = B列の次の候補.Offset(1)
                Set C列の次の出力先 = C列の次の出力先.Offset(1)
            
            End If
            
        Loop

    End With
End Sub

解説

最後に本問用にロジックを構築したバージョンです。

問題文にある

• 列内では数値は昇順
• 列内では重複なし

この条件を使うことで、
　

1. A列・B列の現在先頭の値同士を比べる
2. 小さい方の値をC列に採用し、採用側の列の値をひとつ進める
3. 同じ値なら重複したと判定し、どちらの列の値も進める

これを繰り返すことで本問の解答を作ることが出来ます。

これはマージソートの部分的なアルゴリズムですね。

数式やライブラリで組めるならこういった方法は使う必要はありませんが、
パズル的なロジックを考えるのが楽しい方はこんな解き方もしてみてください。