VBA100本ノック 39本目：数値リストの統合（マージ）
A列とB列の数値を統合（マージ）しユニーク化してC列に出力する問題です。
ツイッターで貰った質問から急遽追加した問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。
出題
出題ツイートへのリンク
#VBA100本ノック 39本目
A列とB列の数値を統合（マージ）しユニーク化してC列に出力します。
・A列、B列ともに行数は不定
・列内では数値は昇順になっています。
・列内では重複していないが、A列とB列では重複します。
・C列へは重複しない数値として昇順に出力してください。
※画像を参考に。
サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_39.xlsm
https://excel-ubara.com/vba100sample/VBA100_39.zip
A列とB列の数値を統合（マージ）しユニーク化してC列に出力します。
・A列、B列ともに行数は不定
・列内では数値は昇順になっています。
・列内では重複していないが、A列とB列では重複します。
・C列へは重複しない数値として昇順に出力してください。
※画像を参考に。
https://excel-ubara.com/vba100sample/VBA100_39.xlsm
https://excel-ubara.com/vba100sample/VBA100_39.zip
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
今回は前日に学生と思われる方からの質問があり、その問題を少し難しくした問題にしました。
おそらくアルゴリズムの勉強なのだと思います。
したがって、解答もそれを意識したコードにしています。
2組のソートされた配列をマージするには左右を比較しながら順に取り出せば良いです。
上記は丁寧に場合分けしたものになります。
昇順に並んでいる＋マージというキーワードからマージソートを思い浮かべた人もいるかもしれません。
注意点は片方が終わった時の処理になります。
大小比較ができなくなるので何らかの記述が必要になります。
上記では残りは片方なのでそれを最後に出力しています。
片方が終わった時の処理方法はいろいろ考えられます。
最大値を使いループを停止させる方法もあります。
これについては記事補足に参考VBAを掲載しました。
オマケとしてSortedListも紹介しておきました。
おそらくアルゴリズムの勉強なのだと思います。
したがって、解答もそれを意識したコードにしています。
2組のソートされた配列をマージするには左右を比較しながら順に取り出せば良いです。
Sub VBA100_39_01()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim i1 As Long, i2 As Long, r As Long
i1 = 1: i2 = 1: r = 1
With ws
.Columns(3).ClearContents
Do Until .Cells(i1, 1) = "" And .Cells(i2, 2) = ""
Select Case True
Case .Cells(i1, 1) = ""
.Cells(r, 3) = .Cells(i2, 2)
i2 = i2 + 1
Case .Cells(i2, 2) = ""
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
Case .Cells(i1, 1) < .Cells(i2, 2)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
Case .Cells(i1, 1) > .Cells(i2, 2)
.Cells(r, 3) = .Cells(i2, 2)
i2 = i2 + 1
Case .Cells(i1, 1) = .Cells(i2, 2)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
i2 = i2 + 1
End Select
r = r + 1
Loop
End With
End Sub
昇順に並んでいる＋マージというキーワードからマージソートを思い浮かべた人もいるかもしれません。
注意点は片方が終わった時の処理になります。
大小比較ができなくなるので何らかの記述が必要になります。
Sub VBA100_39_02()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim i1 As Long, i2 As Long, r As Long
i1 = 1: i2 = 1: r = 1
With ws
.Columns(3).ClearContents
Do Until .Cells(i1, 1) = "" Or .Cells(i2, 2) = ""
Select Case True
Case .Cells(i1, 1) < .Cells(i2, 2)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
Case .Cells(i1, 1) > .Cells(i2, 2)
.Cells(r, 3) = .Cells(i2, 2)
i2 = i2 + 1
Case .Cells(i1, 1) = .Cells(i2, 2)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
i2 = i2 + 1
End Select
r = r + 1
Loop
Do Until .Cells(i1, 1) = ""
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
r = r + 1
Loop
Do Until .Cells(i2, 2) = ""
.Cells(r, 3) = .Cells(i2, 2)
i2 = i2 + 1
r = r + 1
Loop
End With
End Sub
片方が終わった時の処理方法はいろいろ考えられます。
最大値を使いループを停止させる方法もあります。
これについては記事補足に参考VBAを掲載しました。
オマケとしてSortedListも紹介しておきました。
補足
今回は、学生の問題から急遽追加した問題なので、これに沿った解答にしました。
恐らくアルゴリズムの学習なのだと思います。
小さい方を取得する方法として、MIN関数を使った簡潔なコードの解答あります。
恐らくアルゴリズムの学習なのだと思います。
全く別の方法として、
エクセルVBAならではのいろいろな方法もありますが、私の方ではサンプルVBAは書きませんでした。
・シートのMIN[IFS]関数やSMALL関数を使う方法
・2列を縦に並べて重複削除+並べ替え
これらはエクセルならではの処理としてとても良いと思います。
この方法での回答は複数寄せられているので、引用リツイートを見て参考にしてください。
その他として、特殊な方法になりますが、
.NET FrameworkのSortedListクラスを利用したVBAを掲載しておきます。
最大値+1を比較の終了値として使用する
エクセルVBAならではのいろいろな方法もありますが、私の方ではサンプルVBAは書きませんでした。
・シートのMIN[IFS]関数やSMALL関数を使う方法
・2列を縦に並べて重複削除+並べ替え
これらはエクセルならではの処理としてとても良いと思います。
この方法での回答は複数寄せられているので、引用リツイートを見て参考にしてください。
.NET FrameworkのSortedListクラスを利用したVBAを掲載しておきます。
Sub VBA100_39_03()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim stopValue As Long
stopValue = WorksheetFunction.Max(ws.Range("A:B")) + 1
Dim i1 As Long, i2 As Long, r As Long
i1 = 1: i2 = 1: r = 1
With ws
.Columns(3).ClearContents
Do Until .Cells(i1, 1) = "" And .Cells(i2, 2) = ""
Select Case True
Case BlankValue(.Cells(i1, 1), stopValue) < BlankValue(.Cells(i2, 2), stopValue)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
Case BlankValue(.Cells(i1, 1), stopValue) > BlankValue(.Cells(i2, 2), stopValue)
.Cells(r, 3) = .Cells(i2, 2)
i2 = i2 + 1
Case Else '.Cells(i1, 1) = .Cells(i2, 2)
.Cells(r, 3) = .Cells(i1, 1)
i1 = i1 + 1
i2 = i2 + 1
End Select
r = r + 1
Loop
End With
End Sub
Function BlankValue(ByVal rng As Range, ByVal stopValue As Long)
BlankValue = IIf(rng.Value = "", stopValue, rng.Value)
End Function
記述を簡略化するためにFunctionにしましたが、
= "" となったら最大値+1を仮定して比較すれば相手の方の残りが全て出力されます。
これは方法としてはあるのですが、毎回変換関数が呼ばれるので、少々効率が悪いように思います。
VBAには無限大またはデータ型が取りうる最大値を表す定数は存在しません。
ただし、セルで正しく扱える整数は15桁しかないので、これを超える値を扱う事は極めてまれになると思います。
ただし、セルで正しく扱える整数は15桁しかないので、これを超える値を扱う事は極めてまれになると思います。
配列の最後に終了値として最大値+1を入れる
Sub VBA100_39_04()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim stopValue As Long
stopValue = WorksheetFunction.Max(ws.Range("A:B")) + 1
Dim aryA, aryB, aryC
'A列を配列に、最後に最大値+1を入れる
aryA = Range2Array(ws.Range("A1"), stopValue)
'B列を配列に、最後に最大値+1を入れる
aryB = Range2Array(ws.Range("B1"), stopValue)
'出力配列をA列件数+B列件数で作成
ReDim aryC(1 To UBound(aryA, 1) + UBound(aryB, 1), 1 To 1)
Dim i1 As Long, i2 As Long, r As Long
i1 = 1: i2 = 1: r = 1
Do Until aryA(i1, 1) = stopValue And aryB(i2, 1) = stopValue
Select Case True
Case aryA(i1, 1) < aryB(i2, 1)
aryC(r, 1) = aryA(i1, 1)
i1 = i1 + 1
Case aryA(i1, 1) > aryB(i2, 1)
aryC(r, 1) = aryB(i2, 1)
i2 = i2 + 1
Case Else 'aryA(i1, 1) = aryB(i2, 1)
aryC(r, 1) = aryA(i1, 1)
i1 = i1 + 1
i2 = i2 + 1
End Select
r = r + 1
Loop
ws.Columns(3).ClearContents
ws.Range("C1").Resize(UBound(aryC)) = aryC
End Sub
Function Range2Array(ByVal aRng As Range, ByVal stopValue As Long) As Variant
Dim ary
ary = aRng.Resize(aRng.End(xlDown).Row + 1).Value
ary(UBound(ary, 1), 1) = stopValue
Range2Array = ary
End Function
配列の最後に最大値+1を入れておくことで、残らず全てを出力できるようにしています。
.NET FrameworkのSortedListクラスを利用
Sub VBA100_39_05()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim SortList As Object
Set SortList = CreateObject("System.Collections.SortedList")
Call setSortList(SortList, ws.Range("A1", ws.Range("A1").End(xlDown)).Value)
Call setSortList(SortList, ws.Range("B1", ws.Range("B1").End(xlDown)).Value)
Dim ary(), i As Long
ReDim ary(1 To SortList.Count, 1 To 1)
For i = 0 To SortList.Count - 1
ary(i + 1, 1) = SortList.GetKey(i)
Next
ws.Columns(3).ClearContents
ws.Range("C1").Resize(UBound(ary)) = ary
End Sub
Sub setSortList(ByRef SortList As Object, ByRef aAry)
Dim v As Variant
For Each v In aAry
If SortList.Contains(v) = False Then
SortList.Add v, v
End If
Next
End Sub
これについては、あくまで参考としての紹介になります。
.NET Frameworkなので、むやみやたらに使うものではないと思います。
サイト内関連ページ
第82回．RangeのResizeプロパティ
・Resizeプロパティの構文 ・Resizeの使用例 ・Resizeのまとめ
第83回．RangeのOffsetプロパティ・Offsetプロパティの構文 ・Offsetの使用例 ・Offsetの注意点 ・Offsetのまとめ
第112回．動的配列（ReDim）・ReDimステートメント ・要素数の変更について ・配列について
第114回．セル範囲⇔配列（マクロVBA高速化必須テクニック）・セル範囲⇔配列の基本VBA ・使用例 ・配列およびマクロVBAの高速化に関するページ
同じテーマ「VBA100本ノック」の記事
36本目：列の並べ替え
37本目：グラフの色設定
38本目：1シートを複数シートに振り分け
39本目：数値リストの統合（マージ）
40本目：複数ブックの統合
41本目：暗算練習アプリ
42本目：データベース形式に変換
43本目：CSV出力
44本目：全テーブル一覧作成
45本目：テーブルに列追加
46本目：名前定義に使える文字
新着記事NEW ・・・新着記事一覧を見る
AIは便利なはずなのに…「AI疲れ」が次の社会問題になる｜生成AI活用研究(2026-02-16)
カンマ区切りデータの行展開｜エクセル練習問題(2026-01-28)
開いている「Excel/Word/PowerPoint」ファイルのパスを調べる方法｜エクセル雑感(2026-01-27)
IMPORTCSV関数（CSVファイルのインポート）｜エクセル入門(2026-01-19)
IMPORTTEXT関数（テキストファイルのインポート）｜エクセル入門(2026-01-19)
料金表（マトリックス）から金額で商品を特定する｜エクセル練習問題(2026-01-14)
「緩衝材」としてのVBAとRPA｜その終焉とAIの台頭｜エクセル雑感(2026-01-13)
シンギュラリティ前夜：AIは機械語へ回帰するのか｜生成AI活用研究(2026-01-08)
電卓とプログラムと私｜エクセル雑感(2025-12-30)
VLOOKUP/XLOOKUPが異常なほど遅くなる危険なアンチパターン｜エクセル関数応用(2025-12-25)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 39本目：数値リストの統合（マージ）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.