將非連續列複製到多維數組中？

Question

我試圖從一個表格複製值到另一個，比較鍵值（列A & C），或者將值（列E）粘貼到目標工作表中或添加一行並將所有三個值粘貼到A中， C，F.

這裏的數據樣本：

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 

我嘗試使用此代碼的源數據複製到一個數組：

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，並在需要時添加新行。）或者陣列是我最好的選擇？ （會收集更好嗎？）

如果它使事情更容易，我可以粘貼到目標，但source.E仍然需要進入target.F。

謝謝！

Answer 1

集合可以工作，但我更喜歡使用腳本字典。 Scripting Dictionaries有一個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