怎么才能将用VBA 将模板表的数据根据名称复制到各个分表中

chenwenming

怎么才能将用VBA 将模板表的数据根据名称复制到各个分表中新产生一条记录，如果模板中记录在分表中存在就不复制，并跳出对话框提醒。求最快代码

该贴已经同步到 chenwenming的微博

zhaogang1960

ADO法请参考：
Sub Macro1()
    Dim cnn As Object, SQL$, sh As Worksheet
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For Each sh In Sheets
        If sh.Name <> "模板" Then
            SQL = "select a.* from (select 名称,型号,单据,规格 from [模板$] where 名称='" _
                & sh.Name & "') a left join (select 名称&型号&单据&规格 as x  from [" _
                & sh.Name & "$]) b on a.名称&a.型号&a.单据&a.规格=b.x where b.x is null"
            sh.Cells(Rows.Count, 1).End(3).Offset(1).CopyFromRecordset cnn.Execute(SQL)
        End If
    Next
    cnn.Close
    Set cnn = Nothing
End Sub

zhaogang1960

字典法请测试：
Sub Macro2()
    Dim arr, brr, crr(), t, sh As Worksheet, d As Object, ds As Object, i&, m&
    Set d = CreateObject("scripting.dictionary")
    Set ds = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
        d(arr(i, 1)) = d(arr(i, 1)) & "," & i
    Next
    ReDim crr(1 To i, 1 To 4)
    For Each sh In Sheets
        If d.Exists(sh.Name) Then
            brr = sh.[a1].CurrentRegion
            For i = 2 To UBound(brr)
                ds(brr(i, 1) & brr(i, 2) & brr(i, 3) & brr(i, 4)) = ""
            Next
            t = Split(d(sh.Name), ",")
            m = 0
            For i = 1 To UBound(t)
                If Not ds.Exists(arr(t(i), 1) & arr(t(i), 3) & arr(t(i), 4) & arr(t(i), 2)) Then
                    m = m + 1
                    crr(m, 1) = arr(t(i), 1)
                    crr(m, 2) = arr(t(i), 3)
                    crr(m, 3) = arr(t(i), 4)
                    crr(m, 4) = arr(t(i), 2)
                End If
            Next
            If m > 0 Then sh.Cells(Rows.Count, 1).End(3).Offset(1).Resize(m, 4) = crr
            ds.RemoveAll
        End If
    Next
End Sub

LMY123

SQL = "select a.* from (select 名称,型号,单据,规格 from [模板$] where 名称='" _
                & sh.Name & "') a left join (select 名称&型号&单据&规格 as x  from [" _
                & sh.Name & "$]) b on a.名称&a.型号&a.单据&a.规格=b.x where b.x is null"