求助：用公式计算科目余额表太慢，想改用sql查询

ligpz

各位老师，我试着用SQL查询方式从表里提取数据，先计算借方金额和贷方金额，程序如下，但是无法通过，能否帮我完成这个表。
Sub SQL查科目余额()
   
Application.ScreenUpdating = False
   
Dim CNN, SQL$  '定义数据库连接和SQL语句

Dim Maxrow As Integer, i As Integer
Set CNN = CreateObject("adodb.connection")  '创建数据库连接
Set RS = CreateObject("adodb.recordset")   '创建一个数据集保存数据
CNN.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
[D4:E2000].ClearContents

Maxrow = [A65536].End(xlUp).Row
For i = 4 To Maxrow - 3
SQL = " Select sum(iif(isnull(借方金额),0,借方金额)),sum(iif(isnull(贷方金额),0,贷方金额)) from (" & _
        "select 日期,借方金额,贷方金额 from [会计凭证$] where 总账科目 ='&(Cells(i, 1)&' and 明细科目 ='&(Cells(i, 2)&' and 日期<=data(cells(2,4)) and 日期>=data(cells(2,6)）)"
  RS.Open SQL, CNN, adOpenKeyset, adLockOptimistic
  
  Sheets("sheet1").Cells(i, 5).CopyFromRecordset RS
  Set RS = Nothing
  Next i

CNN.Close  '关闭数据库连接

Set CNN = Nothing    '将CNN从内存中删除。
End Sub

ligpz

请大侠们百忙之中帮我一下啊

lk868

Sub SQL查科目余额()
Application.ScreenUpdating = False
Dim cnn, SQL$  '定义数据库连接和SQL语句
Dim Maxrow As Integer, i As Integer
Set cnn = CreateObject("adodb.connection")  '创建数据库连接
Set rs = CreateObject("adodb.recordset")   '创建一个数据集保存数据

cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
[D4:E2000].ClearContents

Maxrow = [A65536].End(xlUp).Row
For i = 4 To Maxrow - 3
   SQL = "Select sum(iif(isnull(借方金额),0,借方金额)),sum(iif(isnull(贷方金额),0,贷方金额)) from (" & _
        "select 日期,借方金额,贷方金额 from [会计凭证$] where 总账科目 & 明细科目='" & Cells(i, 1) & Cells(i, 2) & "' and 日期>=# " & Cells(2, 4) & " # and 日期<=#" & Cells(2, 6) & "#)" '
   rs.Open SQL, cnn, 1, 1 'adOpenKeyset, adLockOptimistic
   Sheets("科目余额表").Cells(i, 5).CopyFromRecordset rs
   rs.Close
Next i
cnn.Close  '关闭数据库连接
Set cnn = Nothing    '将CNN从内存中删除。

End Sub

ligpz

非常感谢lk868,按您的方法，实现了这一功能 ！！

ligpz

非常感谢lk868,按您的方法，实现了这一功能 ！！