Excelに LEFT (OUTER) JOIN を実装

追記。
　まず、これは未熟なコードである、ということを申し述べることにします。
　dictionary は動作が不安定な面があるらしいので、collection で書き直すことにします。
また、日本語名も英語に書き直して、option explicit にします。一生懸命書いたのですが、未熟な点が多々ありました。
　配列に代入すると、速いけれどメモリの使用量を食う、ということを全く考慮していないコードを晒してしまいました。申し訳ございません。
　
　ご叱責をいただきましたら、本文部分は修正、もしくは削除にて対応いたします。遠慮なくおっしゃってください。

[先日書いたもの](https://qiita.com/kazta/items/d67325fd837d2e481c13)
を応用した結果、Excel に LEFT (OUTER) JOIN を実装できました。
もっと洗練させたら、複雑な条件も付けられて、Filter関数をしのぐものができあがるでしょう（多分）。

・テストデータ
![LeftJoin前.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/463205/fe1a56fe-f822-3547-e829-a03612d40ac3.png)

・呼び出し

```vb:実行.bas
Sub LeftOuterJoin実装()

'初期条件

 Dim 検索表開始セル As Range: Set 検索表開始セル = Range("B2")
 Dim 検索条件がある列名 As String: 検索条件がある列名 = "日付"
 
 Dim マスタのキー列が開始するセル As Range: Set マスタのキー列が開始するセル = Range("H3")
 Dim マスタのキー列の名前 As String: 検索をかける列の名前 = "商品ID"
 Dim マスタの価格がある列の名前 As String: 単価がある列の名前 = "単価"
 
 Dim 貼り付けセル As Range: Set 貼り付けセル = Range("B13")
 Dim 開始日付 As Date: 開始日付 = Range("C9").Value
 Dim 終了日付 As Date: 終了日付 = Range("C10").Value
 
 
 '役者の準備
 
 Dim 検索表列辞書 As Object, マスタ列辞書 As Object
 Call 開始セルを指定したらそこから右の行全部入ったDictionaryを作る( _
       検索表開始セル, 検索表列辞書)
 
 Dim マスタ As New Hashtable2D
 Call マスタ.初期設定(マスタのキー列が開始するセル)
 
 Dim 検索条件開始セル As Range: Set 検索条件開始セル = Range( _
      番号からセル番地(検索表開始セル.Row + 1, 検索表列辞書(検索条件がある列名) _
                       ) _
      )
 
 Dim 検索する1次元配列 As Variant
     検索する1次元配列 = _
  表内のその列が開始する最初のセルから表内のその1列全部を1次元配列に格納(検索条件開始セル)
 
 Dim 貼り付け箱() As Variant
 Dim 貼り付け箱の行数 As Integer: 貼り付け箱の列数 = 6 - 1
 Dim 個数 As Long: 個数 = 0 - 1
 Dim 開始列 As Long: 開始列 = 検索条件開始セル.Row
 Dim 今の列 As Long: 今の列 = 開始列 - 1

'いよいよ実行

 Dim LPvar As Variant: For Each LPvar In 検索する1次元配列
  今の列 = 今の列 + 1
  If 開始日付 <= LPvar And LPvar <= 終了日付 Then
   個数 = 個数 + 1: ReDim Preserve 貼り付け箱(貼り付け箱の列数, 個数)
    
   貼り付け箱(0, 個数) = Cells(今の列, 検索表列辞書("ID")).Value
   貼り付け箱(1, 個数) = LPvar
   貼り付け箱(2, 個数) = マスタ.辞書を引く(Cells(今の列, 検索表列辞書("商品ID")).Value, "商品名")
   貼り付け箱(3, 個数) = Cells(今の列, 検索表列辞書("個数")).Value
   貼り付け箱(4, 個数) = マスタ.辞書を引く(Cells(今の列, 検索表列辞書("商品ID")).Value, "単価")
   貼り付け箱(5, 個数) = 貼り付け箱(3, 個数) * 貼り付け箱(4, 個数)
  
  End If
  Next LPvar
  
  Call キレイな配列を貼り付け(貼り付けセル, 貼り付け箱)
End Sub

```

・共通ライブラリ

```vb:共通ライブラリ.bas
'// 1. セル関連
'// セルのRangeオブジェクトから、セル番地の文字列を返させる(例."C25")
Public Function 番号からセル番地(行番号 As Long, 列番号 As Long) As String
 番号からセル番地 = 数字をEXCELの列アルファベットに変換(列番号) & 行番号
End Function
Public Function 数字をEXCELの列アルファベットに変換(iCol As Long) As String
 Dim iAlpha As Integer: iAlpha = Int(iCol / 27)
 Dim iRemainder As Integer: iRemainder = iCol - (iAlpha * 26)
 If iAlpha > 0 Then
  数字をEXCELの列アルファベットに変換 = Chr(iAlpha + 64)
 End If
 If iRemainder > 0 Then
  数字をEXCELの列アルファベットに変換 = 数字をEXCELの列アルファベットに変換 & Chr(iRemainder + 64)
 End If
End Function

Public Function そのセルのCurrentRegionの最後のセル(基準セル As Range) As Range
 With 基準セル
  Set そのセルのCurrentRegionの最後のセル = .CurrentRegion.Item(.CurrentRegion.Count)
 End With
End Function

'// 2. 配列関連
' 開始セルを指定したらその行のDictionaryを作る(キー：値, アイテム：列番号)
Public Sub 開始セルを指定したらそこから右の行全部入ったDictionaryを作る(開始セル As Range, 辞書 As Object)
 Set 辞書 = CreateObject("Scripting.Dictionary")
 Dim その行の1次元配列 As Variant
     その行の1次元配列 = 表内セルのそこから右全部を1次元配列に格納(開始セル)
 Dim LPvar As Variant: For Each LPvar In その行の1次元配列
 'Application.Matchは、-1:検査値以上の最小値, 0:検査値に完全一致する値, 1:検査値以下の最大値
  辞書.Add LPvar, 開始セル.Column + Application.Match(LPvar, その行の1次元配列, 0) - 1
  Next LPvar
End Sub
' セルのRangeオブジェクトを渡すバージョン
Public Function 表内セルのそこから右全部を1次元配列に格納(表内セル As Range) As Variant
 Dim LC As Long: LC = そのセルのCurrentRegionの最後のセル(表内セル).Column
 Dim ARR() As Variant: ARR = 表内セル.Resize(, LC - 表内セル.Column + 1).Value
 
 表内セルのそこから右全部を1次元配列に格納 = 一次元配列に整形(ARR)
End Function

Public Function 表内のその列が開始する最初のセルから表内のその1列全部を1次元配列に格納( _
        開始セル As Range) As Variant
 Dim LR As Long: LR = そのセルのCurrentRegionの最後のセル(開始セル).Row
 Dim ARR() As Variant: ARR = 開始セル.Resize(LR - 開始セル.Row + 1).Value
 
 表内のその列が開始する最初のセルから表内のその1列全部を1次元配列に格納 = 一次元配列に整形(ARR)
End Function

' Range(縦1行か横1行).Value で渡す配列の初期値は2次元なので、1次元に転換してやる
Public Function 一次元配列に整形(配列 As Variant) As Variant
  Select Case UBound(配列, 2)
  Case 1: 一次元配列に整形 = WorksheetFunction.Transpose(配列)
  Case Is > 1: 一次元配列に整形 = WorksheetFunction.Transpose(WorksheetFunction.Transpose(配列))
  End Select
End Function

Public Sub キレイな配列を貼り付け(貼り付け開始セル As Range, 配列)
 配列 = WorksheetFunction.Transpose(配列)
 Dim iRowMax: iRowMax = UBound(配列, 1) - LBound(配列, 1) + 1 '// 一次元配列の最大行数
 Dim iColMax: iColMax = UBound(配列, 2) - LBound(配列, 2) + 1 '// 二次元配列の最大列数
 貼り付け開始セル.Resize(iRowMax, iColMax).Value = 配列 '// 開始セルから貼り付ける
End Sub

Public Function 配列の次元数をゲット(配列 As Variant) As Long
 Dim TempData As Variant, i As Long, 次元数 As Long
 On Error Resume Next: Do While Err.Number = 0
  i = i + 1: TempData = UBound(配列, i)
 Loop: On Error GoTo 0
 配列の次元数をゲット = i - 1
End Function
```
・ハッシュテーブルクラス

```vb:HastTable2D.cls
Public 辞書 As Object
Public 列名 As Object

Public Sub 初期設定(ByRef 開始セル As Range)

 Dim 表の終了セル As Range
 Set 表の終了セル = そのセルのCurrentRegionの最後のセル(開始セル)
 Dim RSR As Long, RSC As Long, RER As Long, REC As Long
 
 With 開始セル
  RSR = .Row: RSC = .Column: RER = 表の終了セル.Row: REC = 表の終了セル.Column
 End With
 
 Dim キーに入れたいセルたち As Range, アイテムに入れたいセルたち As Range
 Dim lpRng As Range, lpCnt As Long: lpCnt = 1
 Dim arrTMP As Variant
 
  Set 辞書 = CreateObject("Scripting.Dictionary")
  Set 列名 = CreateObject("Scripting.Dictionary")
 
  Set キーに入れたいセルたち = 開始セル.Resize(, REC - RSC + 1)
  For Each lpRng In キーに入れたいセルたち
   列名.Add lpRng.Value, lpCnt: lpCnt = lpCnt + 1
  Next lpRng
   
  Set アイテムに入れたいセルたち = キーに入れたいセルたち
  Set キーに入れたいセルたち = 開始セル.Offset(1).Resize(RER - RSR)
  
  For Each lpRng In キーに入れたいセルたち
   Set アイテムに入れたいセルたち = アイテムに入れたいセルたち.Offset(1)
   If 配列の次元数をゲット(アイテムに入れたいセルたち.Value) = 2 Then
    ARR = 一次元配列に整形(アイテムに入れたいセルたち.Value)
   End If
   辞書.Add lpRng.Value, ARR
  Next lpRng

'----デバッグ用----
'辞書の中身を全部見せて
 Dim var As Variant, lp1 As Long, varIdx As Variant
 
 Debug.Print vbCr & "まず列名の辞書から" & vbLf
 For Each var In 列名
  Debug.Print "列名(""" & var & """):", 列名(var)
 Next var
 Debug.Print vbCr & "お次は本体の辞書" & vbLf
 For Each var In 辞書
  For lp1 = 1 To REC - RSC + 1
   Debug.Print "辞書(""" & var & """)(" & lp1 & "):", 辞書(var)(lp1)
  Next lp1
 Next var
 Debug.Print vbCr & "いよいよ本番" & vbLf
 For Each var In 辞書
  For Each varIdx In 列名
   Debug.Print "辞書(""" & var & """)(列名(""" & varIdx & """)):", 辞書(var)(列名(varIdx))
    Next varIdx
   Next var
 Debug.Print

End Sub

'// 2. これが、メインのキモとなる機能
Public Function 辞書を引く(キー As Variant, 欲しい列名 As Variant) As Variant
  Select Case True
  Case 辞書.exists(キー) And 列名.exists(欲しい列名): 辞書を引く = 辞書(キー)(列名(欲しい列名))
  Case Not 辞書.exists(キー) And 列名.exists(欲しい列名): 辞書を引く = CVErr(1)
  Case 辞書.exists(キー) And Not 列名.exists(欲しい列名): 辞書を引く = CVErr(2)
  Case Not 辞書.exists(キー) And Not 列名.exists(欲しい列名): 辞書を引く = CVErr(3)
  End Select
End Function

```

・実行結果
![LeftJoin後.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/463205/33329b45-131c-8800-fa28-73ee2fb90ed3.png)