数据连接汇总

CNS1993

数据连接汇总，详见附件，谢谢！ 数据连接汇总求助.rar (44.88 KB, 下载次数: 30)

2018-8-31 13:42 上传

点击文件名下载附件

魂断蓝桥

Sub a()
Dim arr, i%, s$, cnn, strsql$, myfile$, lr%, r%
myfile = ThisWorkbook.Path & "\test.mdb"
lr = Sheet1.[a65535].End(3).Row
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;data source=" & myfile
strsql = "INSERT INTO tblOrder SELECT A.* FROM [Excel 12.0;Database=" & ThisWorkbook.FullName & ";].[Order$" & "A1:P" & lr _
            & "] A LEFT JOIN tblOrder B ON A.[SO]=B.[SO] WHERE B.[SO] IS NULL"
cnn.Execute strsql, r
MsgBox "插入" & r & "条数据"
Set cnn = Nothing
End Sub

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr(1), i, j, k, dic, n
  Set dic = CreateObject("scripting.dictionary")
  Call getdatatoarr(arr, 0, "数据表1", "ah4", 6)
  Call getdatatoarr(arr, 1, "数据表2", "aq2", 6)
  ReDim brr(1 To UBound(arr(0), 1) + UBound(arr(1), 1), 1 To 6)
  For i = 0 To UBound(arr)
    For j = 1 To UBound(arr(i), 1)
      If dic.exists(arr(i)(j, 2)) Then
        brr(dic(arr(i)(j, 2)), 6) = brr(dic(arr(i)(j, 2)), 6) + arr(i)(j, 6)
        brr(dic(arr(i)(j, 2)), 3) = brr(dic(arr(i)(j, 2)), 3) + arr(i)(j, 3)
      Else
        n = n + 1
        For k = 1 To UBound(arr(i), 2): brr(n, k) = arr(i)(j, k): Next
        dic(arr(i)(j, 2)) = n
      End If
  Next j, i
  With Sheets("数据表1").[as4]
    .Resize(Rows.Count - 3, UBound(brr, 2)).ClearContents
    .Resize(n, 6) = brr
  End With
End Sub

Function getdatatoarr(arr, i, sht, pos, n)
  With Sheets(sht)
    arr(i) = .Range(pos).Resize(.Cells(Rows.Count, .Range(pos).Column).End(xlUp).Row, n)
  End With
End Function

CNS1993

一把小刀闯天下 发表于 2018-8-31 15:19
Option Explicit

Sub test()

很好。。但第一次接触自定义函数。。。。更期待其它的方法。谢谢！！辛苦了！