【求助】大数据库的匹配查询

LLLCCCDDD

查看附件 例子.zip (8.39 KB, 下载次数: 19)

2018-7-16 10:17 上传

点击文件名下载附件

LLLCCCDDD

求助，表头要对应并且为之不能动。。

zopey

Sub 按钮1_Click()
Dim dic, arr()
Set dic = CreateObject("Scripting.Dictionary")

Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName


Sql2 = "select * from [sheet2$]"
    Set rst2 = CreateObject("adodb.Recordset")
    rst2.Open Sql2, cnn, 1, 1
    k = 0
    ReDim arr(1 To rst2.RecordCount, 1 To 5)
    Do While Not rst2.EOF
       k = k + 1
       dic(rst2("号码") & "") = k
       arr(k, 1) = rst2("属性1")
       arr(k, 2) = rst2("属性2")
       arr(k, 3) = rst2("单价")
       arr(k, 4) = rst2("属性2")
       arr(k, 5) = rst2("单位")
    rst2.movenext
    Loop

cnn.Close
Set cnn = Nothing

Dim brr, k0
k0 = [a1].End(4).Row - 1
brr = [a2].Resize(k0, 8)
For i = 1 To k0
   k = dic(brr(i, 1) & "")
   brr(i, 4) = arr(k, 1)
   brr(i, 5) = arr(k, 2)
   brr(i, 6) = arr(k, 3)
   brr(i, 7) = arr(k, 4)
   brr(i, 8) = arr(k, 5)
Next

[a2].Resize(k0, 8) = brr
End Sub

例子2.zip (16.81 KB, 下载次数: 18)

2018-7-16 10:56 上传

点击文件名下载附件

zopey

    arr(k, 4) = rst2("属性2")  
    此句代码有笔误 改为
    arr(k, 4) = rst2("属性3")  

我是来讨说法的

1. Sub Test4()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, strSQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
   
8.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14.     '设置SQL查询语句
    
15.     strSQL = "Select 号码,其余属性1,其余属性2,属性1,属性2,单价,属性3,单位 From [Sheet2$] Where 号码 In ('t201805','t201806')"
    
16.     'strSQL = "Select * From [Sheet2$]"
    
17.     Conn.Open strConn    '打开数据库链接
    
18.     Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    
19.     With Sheet1
    
20.         '.Cells.Clear
    
21.         .Range("A2").CopyFromRecordset Rst
    
22.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
23.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
24.     End With
    
25.     Rst.Close    '关闭数据库连接
    
26.     Conn.Close
    
27.     Set Conn = Nothing
    
28.     Set Rst = Nothing
    
29. End Sub

复制代码

自己再稍微修改一下吧

LLLCCCDDD

我是来讨说法的 发表于 2018-7-16 11:21
自己再稍微修改一下吧

请问下这个有没有excel版本限制或者需要什么相关的组件插件之类的？

我是来讨说法的

LLLCCCDDD 发表于 2018-7-16 11:23
请问下这个有没有excel版本限制或者需要什么相关的组件插件之类的？

没有》》》》》》》》

LLLCCCDDD

zopey 发表于 2018-7-16 10:59
arr(k, 4) = rst2("属性2")  
    此句代码有笔误 改为
    arr(k, 4) = rst2("属性3")

请问下有没有就是用普通数组的方法，就是不需要用sql查询的那种，就是d.exists的那种？

LLLCCCDDD

我是来讨说法的 发表于 2018-7-16 11:24
没有》》》》》》》》

请问下有没有就是用普通数组的方法，就是不需要用sql查询的那种，就是d.exists的那种？

我是来讨说法的

sql最快》》》》