在线等！谢谢！

ericxzhou

1. Sub test()
   
2.     Dim sql$, arr
   
3.     sql = "select 物料号, 零件名, 供应商, sum(单台数量) from [清单$k2:ah] group by 物料号, 零件名, 供应商"
   
4.     arr = GET_SQL(sql, False)
   
5.     Sheets("汇总").[b3].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
   
6. End Sub
   
7. 
   
8. 
   
9. Public Function GET_SQL(strSQL As String, Optional HasHeader As Boolean = True) As Variant()
   
10.     Dim Cn, Rs, arr(), i&, j&
    
11.     Set Cn = CreateObject("ADODB.Connection")
    
12.     Set Rs = CreateObject("ADODB.Recordset")
    
13.     If Application.Version < 12 Then
    
14.         Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    
15.     Else
    
16.         Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    
17.     End If
    
18.     Rs.Open strSQL, Cn, 1, 3
    
19.     If HasHeader = True Then
    
20.         ReDim arr(0 To Rs.RecordCount, 0 To Rs.Fields.Count - 1)
    
21.         For i = 0 To Rs.Fields.Count - 1
    
22.            arr(0, i) = Rs.Fields(i).Name
    
23.         Next
    
24.         For i = 0 To Rs.RecordCount - 1
    
25.             For j = 0 To Rs.Fields.Count - 1
    
26.                 arr(i + 1, j) = Rs.Fields(j).Value
    
27.             Next
    
28.             Rs.MoveNext
    
29.         Next
    
30.     Else
    
31.          ReDim arr(0 To Rs.RecordCount - 1, 0 To Rs.Fields.Count - 1)
    
32.          For i = 0 To Rs.RecordCount - 1
    
33.              For j = 0 To Rs.Fields.Count - 1
    
34.                  arr(i, j) = Rs.Fields(j).Value
    
35.              Next
    
36.              Rs.MoveNext
    
37.          Next
    
38.          '注意用GetRows方法转置会遇到NULL转置报错的情况
    
39.     End If
    
40.     GET_SQL = arr
    
41.     Cn.Close
    
42.     Set Rs = Nothing
    
43.     Set Cn = Nothing
    
44. End Function
    

复制代码

leimingsen

hmc530 发表于 2022-6-9 11:07
可以给我个附件不？这个怎么用的呀！

python 参考！！！