Question

我正在尝试将值从一个工作表复制到另一个工作表，比较Key值（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并在需要时添加新行。）或者数组是我最好的选择吗？（收藏会更好吗？）

如果它让事情变得更容易，我可以将A：D粘贴到目标中，但是source.E仍然需要进入target.F。

谢谢！

Answer 1

集合可以使用，但我更喜欢使用脚本字典。脚本字典有一个存在方法，您可以使用它来查看密钥是否已存在，集合不是。将密钥添加到集合时，您必须避免因尝试添加重复密钥而导致的任何错误。

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

将非连续列复制到多维数组中？

1 个答案: