求跨薄添加表中几列数据的VBA

feilv205

需要解决的问题：

将“任务表”中A-D列、G-Q列数据添加到另一工作薄名为sc1的工作表名为sc11的表中，列标题一致。

当“任务表”有新数据需要添加时，在sc11所添加的数据不覆盖前面的数据。

sc1工作薄路径为D:\sc\sc1，密码123456

用拷贝法已经实现，但数据稍多就慢，所以求各位老师帮弄个快捷的代码。谢谢！

搞定，代码见回复。

可能不是最优办法，但较拷贝法要快，继续学习！

chaohuahch

你需要把SC1的工作簿，最好也上传一份，如果要提供速度的话，肯定要用数组，但是不清楚，SC11工作表里面的标题顺序，是否与测试工作表的一致，所以无法直接写代码。

feilv205

chaohuahch 发表于 2018-8-27 19:16
你需要把SC1的工作簿，最好也上传一份，如果要提供速度的话，肯定要用数组，但是不清楚，SC11工作表里面的 ...

你好！

这点忽略没说明白，sc11表的列结构与上传的一致，就是少了不需要添加的列，即把不需要添加的列删除就是sc11表。

在坛里曾看到个类似的例子，好像是用字典+数组，取得已有数据行的代码后，直接用列相等就搞定，但偶再找那个贴子一直没找到。

chaohuahch

用字典套数组的方式会更好。参考我回复的一个帖子。

http://club.excelhome.net/forum. ... 6orderby%3Ddateline

你可以用采购的任务编号（如果它是唯一值）作为字典的key。你要的A~D列，G~Q列，联合起来的区域，作为字典的item。然后再新的表格里面查询字典，就可以了。

feilv205

chaohuahch 发表于 2018-8-27 20:09
用字典套数组的方式会更好。参考我回复的一个帖子。

http://club.excelhome.net/forum.php?mod=viewthre ...

非常感谢，明天我试试看。A列、C列是唯一值。

feilv205

chaohuahch 发表于 2018-8-27 20:09
用字典套数组的方式会更好。参考我回复的一个帖子。

http://club.excelhome.net/forum.php?mod=viewthre ...

老师，小白的我真搞不定，麻烦出手救助一下！

feilv205

用前不久求助按列中条件分配信息的代码修改后搞定！

Sub sc任务()
Dim myr%, m%, wb As Workbook, Rng As Range
myr = Range("b65535").End(3).Row
ar = Range("a1:t" & myr)
Set wb = Workbooks.Open("d:\sc\sc1.xlsm", Password:="123456")
    With wb.Sheets("sc11")
    m = Range("a1").End(3).Row
    am = Range("a" & m).Value
    Set Rng = ThisWorkbook.Sheets("任务表").Columns(1).Find(am, , , xlWhole)
    If Rng Is Nothing Then
        wb.Close: Exit Sub
    Else
        R = Rng.Row
    End If
    If myr = R Then wb.Close: Exit Sub
    ReDim br(1 To myr, 1 To 16)
    For i = R To myr
       'If Val(Mid(ar(i, 15), 2, 1)) >= 2 Or Val(Mid(ar(i, 15), 3, 1)) >= 2 Then （原来用的条件）
            n = n + 1
            br(n, 1) = ar(i, 1)
            br(n, 2) = ar(i, 2)
            br(n, 3) = ar(i, 3)
            br(n, 4) = ar(i, 4)
            br(n, 5) = ar(i, 7)
            br(n, 6) = ar(i, 8)
            br(n, 7) = ar(i, 9)
            br(n, 8) = ar(i, 10)
            br(n, 9) = ar(i, 12)
            br(n, 10) = ar(i, 13)
            br(n, 11) = ar(i, 14)
            br(n, 12) = ar(i, 15)
            br(n, 13) = ar(i, 16)
            br(n, 14) = ar(i, 17)
            br(n, 15) = ar(i, 18)
            br(n, 16) = ar(i, 20)
       'End If
    Next
        .Range("a" & m).Resize(n, 16) = br
    End With
wb.Close 1
Set wb = Nothing
MsgBox "sc分配完成"

End Sub

feilv205

加了三列数据，出现“下标越界”，搞半天还是。
才发现是
ar = Range("a1:t" & myr)
中“a1:t”设定的范围只到t列，修改为：
ar = Range("a1:w" & myr)
就OK

继续学习！