不連続な列を多次元配列にコピーしますか？

Question

キー値（列A & C）を比較し、値を（列E）をターゲットシートに貼り付けるか、行を追加してA、

SOURCE TABLE 
A  B  C  D  E 
Name Ext  Dept Days w22Hrs 
------- ------- ------- ------- ------- 
Alan x101 Level1 MTWTF 8 
Brian x102 Level1 MTWTF 30 
Claire x103 Level1 MTWTF 40 
Denise x104 Level2 MTWTF 16 
Denise x105 Level1 MTWTF 24 

TARGET TABLE 
A  B  C  D  E  F 
Name Ext  Dept Days w21Hrs w22Hrs 
------- ------- ------- ------- ------- ------- 
Brian x102 Level1 MTWTF 32  
Denise x104 Level2 MTWTF 16  
Denise x105 Level1 MTWTF 8  
Eric x106 Level1 MTWTF 36  

DESIRED RESULT 
A  B  C  D  E  F 
Name Ext  Dept Days w21Hrs w22Hrs 
------- ------- ------- ------- ------- ------- 
Alan   Level1   0  8 
Brian x102 Level1 MTWTF 32  30 
Claire   Level1   0  40 
Denise x104 Level2 MTWTF 16  16 
Denise x105 Level1 MTWTF 8  24 
Eric x106 Level1 MTWTF 36  0 

私はこのコードを使用して配列にソースデータをコピーしようとした：C、F.

はここでデータのサンプルの値は

set rng = union(range("A2:A6"), range("C2:C6"), range("E2:E6")) 
arrTemp = rng.value2 
arr = application.transpose(arrTemp) 

をしかし、私が得るすべてがありますA2：A6から。しかし、これは動作します：

set rng = range("A2:E6") 
arrTemp = rng.value2 
arr = application.transpose(arrTemp) 

1 - 私は配列にしたいだけの列を置く簡単な方法はありますか？ （セル領域を反復することは、私にとっては控えめなようです）

2 - ターゲットシートを更新するという全体的な目的を達成する簡単な方法はありますか？ （既存の行のw ## Hrsを更新し、必要に応じて新しい行を追加したいということを覚えておいてください）または配列が私の最高の賭けですか？ （コレクションはより良いでしょうか）

もしそれが楽になるなら、私はターゲットにA：Dを貼り付けることができますが、source.Eはまだtarget.Fに入る必要があります。

ありがとうございます！

Answer 1

コレクションは機能しますが、私はスクリプトディクショナリを使用することをお勧めします。スクリプティングディクショナリにはExistsメソッドがあり、Keyがすでに存在し、コレクションが存在しないかどうかを確認できます。 Keysをコレクションに追加するときは、重複したキーを追加しようとするとエラーが発生した場合、エスケープする必要があります。

Sub UpdateTargetTable() 
    Dim k As String 
    Dim lastRow As Long, x As Long 
    Dim dict As Object 
    Dim arr 

    Set dict = CreateObject("Scripting.Dictionary") 

    With Worksheets("Source") 
     lastRow = .Range("A" & Rows.Count).End(xlUp).Row 

     For x = 2 To lastRow 
      k = .Cells(x, 1) & .Cells(x, 2) 

      If Not dict.Exists(k) Then 
       dict.Add k, .Range(.Cells(x, 3), .Cells(x, 5)).Value 
      End If 

     Next 

    End With 

    With Worksheets("Target") 
     lastRow = .Range("A" & Rows.Count).End(xlUp).Row 

     For x = 2 To lastRow 
      k = .Cells(x, 1) & .Cells(x, 2) 

      If dict.Exists(k) Then 
       arr = dict(k) 

       .Cells(x, 3) = arr(1, 1) 
       .Cells(x, 4) = arr(1, 2) 
       .Cells(x, 6) = arr(1, 3) 

      End If 

     Next 

    End With 

End Sub