您所在位置：主题：[原创]请高手帮我查看下面的代码错在哪里
excel2007
[专家分：0] 发布于 2010-05-18 09:13:00
一下代码不能得到正确结果
起初余额表
姓名 金额
龚雨雨 5000
陈建华 500
刘平 7000
本期发生额表
日期 姓名 本期增加 本期减少 事由
2010-5-10 陈建华 4789 0
2010-5-11 陈建华 0 8888
2010-5-12 张飞 14236 0
2010-5-13 龚雨雨 5489 0
2010-5-14 陈建华 0 500
2010-5-14 陈建华 0 147
2010-5-14 陈建华 22222 0
2010-5-15 陈龙狮 2000 0 备用金
2010-5-15 陈建华 0 100
2010-5-16 刘平 1000 200
Public Sub to_Excel()
'On Error Resume Next
Dim xlsApp As Excel.Application
Dim xlsWbk As Excel.Workbook
Dim xlsWst As Excel.Worksheet
Set xlsApp = New Excel.Application
Set xlsWbk = xlsApp.Workbooks.Add
Set xlsWst = xlsApp.Worksheets(1)
xlsWst.Range("a1:g1").Merge
xlsWst.Range("a3:g3").Merge
xlsWst.Range("a1").Font.Bold = True
xlsWst.Range("a1").Font.Size = 16
xlsWst.Range("a1") = "新华教育集团借款情况日报表"
xlsWst.Range("a3") = " 本期借款及变化明细表"
xlsWst.Range("a1").HorizontalAlignment = xlCenter
xlsWst.Range("a3").HorizontalAlignment = xlCenter
xlsWst.Range("d2") = Format(frmMain.DTPicker1.Value, "YYYY年MM月DD日")
xlsWst.Range("g2") = " 单位：元"
xlsWst.Range("a4") = " 序号"
xlsWst.Range("b4") = " 单位/员工名称"
xlsWst.Range("c4") = " 前期余额"
xlsWst.Range("d4") = " 本期增加"
xlsWst.Range("e4") = " 本期减少"
xlsWst.Range("f4") = " 期末结余"
xlsWst.Range("g4") = " 事 由"
Set Cn = New ADODB.Connection
Set Rs = New ADODB.Recordset
Cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Mydata.Mdb"
Cn.Open
Dim strSQL As String
strSQL = "Select 姓名 ,(Sum(本期增加)-Sum(本期减少)) as 净增减 from 本期发生额表 where 日期 < #" & frmMain.DTPicker1.Value & "# GROUP BY 姓名 order by 姓名 "
Rs.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
Dim i As Long
i = 5
'如果Rs.EOF=true说明 此[日期]为最早日期
If Rs.EOF Then
Dim RsRecordset As ADODB.Recordset
Set RsRecordset = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 日期 = #" & frmMain.DTPicker1.Value & "# GROUP BY 姓名 order by 姓名"
RsRecordset.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
Do Until RsRecordset.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = RsRecordset!姓名
xlsWst.Range("d" & i) = RsRecordset!增加
xlsWst.Range("e" & i) = RsRecordset!减少
'xlsWst.Range("g" & i) = IIf(IsNull(RsRecordset!事由), "", RsRecordset!事由)
Dim Rest12 As ADODB.Recordset
Set Rest12 = New ADODB.Recordset
Rest12.Open "Select * from 起初余额表 order by 姓名 where 姓名= '" & RsRecordset!姓名 & "'", Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest12.EOF Then
GoTo Line123:
Else
xlsWst.Range("c" & i) = Rest12!金额
End If
Line123:
'Line44:
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
RsRecordset.MoveNext
Loop
Else
Do Until Rs.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rs!姓名
xlsWst.Range("c" & i) = Rs!净增减
Dim Rest As ADODB.Recordset
Set Rest = New ADODB.Recordset
Rest.Open "Select * from 起初余额表 where 姓名= '" & Rs!姓名 & "'", Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest.EOF Then
GoTo line2:
Else
xlsWst.Range("c" & i) = Rs!净增减 + Rest!金额
End If
'Line3:
Dim Rs2 As ADODB.Recordset
Set Rs2 = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 姓名='" & Rest!姓名 & "' and 姓名 in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "# ) and 日期=#" & frmMain.DTPicker1.Value & "# GROUP BY 姓名"
Rs2.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rs2.EOF Then
GoTo line2:
Else
xlsWst.Range("d" & i) = Rs2!增加
xlsWst.Range("e" & i) = Rs2!减少
'xlsWst.Range("g" & i) = IIf(IsNull(Rs2!事由), "", Rs2!事由)
End If
line2:
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
Dim Rst1 As ADODB.Recordset
Set Rst1 = New ADODB.Recordset
Rst1.Open "Select Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 日期=#" & frmMain.DTPicker1.Value & "# and 姓名 ='" & Rs!姓名 & "' GROUP BY 姓名 order by 姓名 ", Cn, adOpenKeyset, adLockReadOnly, adCmdText
If Rst1.EOF Then
GoTo line1:
End If
xlsWst.Range("d" & i) = IIf(IsNull(Rst1!增加), 0, Rst1!增加)
xlsWst.Range("e" & i) = IIf(IsNull(Rst1!减少), 0, Rst1!减少)
'xlsWst.Range("g" & i) = IIf(IsNull(Rst1!事由), "", Rst1!事由)
line1:
Rs.MoveNext
i = i + 1
Loop
Rs.Close
'结束 End If
End If
Dim Rest1 As ADODB.Recordset
Set Rest1 = New ADODB.Recordset
strSQL = "Select * from 起初余额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "#)"
Rest1.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest1.EOF Then
GoTo Line4:
End If
Do Until Rest1.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rest1!姓名
xlsWst.Range("c" & i) = Rest1!金额
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rest1.MoveNext
Loop
Line4:
Dim Rs22 As ADODB.Recordset
Set Rs22 = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "# ) and 姓名 not in ( Select 姓名 from 起初余额表 ) and 日期=#" & frmMain.DTPicker1.Value & "# GROUP BY 姓名"
Rs22.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rs22.EOF Then
GoTo Line22:
End If
Do Until Rs22.EOF
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rs22!姓名
xlsWst.Range("d" & i) = IIf(IsNull(Rs22!增加), 0, Rs22!增加)
xlsWst.Range("e" & i) = IIf(IsNull(Rs22!减少), 0, Rs22!减少)
'xlsWst.Range("g" & i) = IIf(IsNull(Rs22!事由), "", Rs22!事由)
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rs22.MoveNext
Loop
'姓名 不在 本期发生额表
Dim Rest131 As ADODB.Recordset
Set Rest131 = New ADODB.Recordset
strSQL = "Select * from 起初余额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期=#" & frmMain.DTPicker1.Value & "# or 日期<#" & frmMain.DTPicker1.Value & "#) and 姓名 in (Select 姓名 from 起初余额表 ) "
Rest131.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest131.EOF Then
GoTo Line22:
End If
Do Until Rest131.EOF
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rest131!姓名
xlsWst.Range("c" & i) = Rest131!金额
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rest131.MoveNext
Loop
'直接转到
GoTo Line22:
'如果不是这样
Line22:
xlsWst.Range("b" & i + 1) = "合 计："
xlsWst.Range("c" & i + 1) = "=sum(c5:c" & i & ")"
xlsWst.Range("d" & i + 1) = "=sum(d5:d" & i & ")"
xlsWst.Range("e" & i + 1) = "=sum(e5:e" & i & ")"
xlsWst.Range("f" & i + 1) = "=sum(f5:f" & i & ")"
xlsWst.Range("a" & i + 2 & ":g" & i + 2).Merge
xlsWst.Range("a" & i + 2) = "单位负责人：xxx 财务负责人：xxx 填表人：xxx"
xlsWst.Columns.AutoFit
xlsApp.Visible = True
Set xlsApp = Nothing
End Sub
来源: http://www.programbbs.com/bbs/announce.asp?boardid=21
起初余额表
姓名 金额
龚雨雨 5000
陈建华 500
刘平 7000
本期发生额表
日期 姓名 本期增加 本期减少 事由
2010-5-10 陈建华 4789 0
2010-5-11 陈建华 0 8888
2010-5-12 张飞 14236 0
2010-5-13 龚雨雨 5489 0
2010-5-14 陈建华 0 500
2010-5-14 陈建华 0 147
2010-5-14 陈建华 22222 0
2010-5-15 陈龙狮 2000 0 备用金
2010-5-15 陈建华 0 100
2010-5-16 刘平 1000 200
Public Sub to_Excel()
'On Error Resume Next
Dim xlsApp As Excel.Application
Dim xlsWbk As Excel.Workbook
Dim xlsWst As Excel.Worksheet
Set xlsApp = New Excel.Application
Set xlsWbk = xlsApp.Workbooks.Add
Set xlsWst = xlsApp.Worksheets(1)
xlsWst.Range("a1:g1").Merge
xlsWst.Range("a3:g3").Merge
xlsWst.Range("a1").Font.Bold = True
xlsWst.Range("a1").Font.Size = 16
xlsWst.Range("a1") = "新华教育集团借款情况日报表"
xlsWst.Range("a3") = " 本期借款及变化明细表"
xlsWst.Range("a1").HorizontalAlignment = xlCenter
xlsWst.Range("a3").HorizontalAlignment = xlCenter
xlsWst.Range("d2") = Format(frmMain.DTPicker1.Value, "YYYY年MM月DD日")
xlsWst.Range("g2") = " 单位：元"
xlsWst.Range("a4") = " 序号"
xlsWst.Range("b4") = " 单位/员工名称"
xlsWst.Range("c4") = " 前期余额"
xlsWst.Range("d4") = " 本期增加"
xlsWst.Range("e4") = " 本期减少"
xlsWst.Range("f4") = " 期末结余"
xlsWst.Range("g4") = " 事 由"
Set Cn = New ADODB.Connection
Set Rs = New ADODB.Recordset
Cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Mydata.Mdb"
Cn.Open
Dim strSQL As String
strSQL = "Select 姓名 ,(Sum(本期增加)-Sum(本期减少)) as 净增减 from 本期发生额表 where 日期 < #" & frmMain.DTPicker1.Value & "# GROUP BY 姓名 order by 姓名 "
Rs.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
Dim i As Long
i = 5
'如果Rs.EOF=true说明 此[日期]为最早日期
If Rs.EOF Then
Dim RsRecordset As ADODB.Recordset
Set RsRecordset = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 日期 = #" & frmMain.DTPicker1.Value & "# GROUP BY 姓名 order by 姓名"
RsRecordset.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
Do Until RsRecordset.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = RsRecordset!姓名
xlsWst.Range("d" & i) = RsRecordset!增加
xlsWst.Range("e" & i) = RsRecordset!减少
'xlsWst.Range("g" & i) = IIf(IsNull(RsRecordset!事由), "", RsRecordset!事由)
Dim Rest12 As ADODB.Recordset
Set Rest12 = New ADODB.Recordset
Rest12.Open "Select * from 起初余额表 order by 姓名 where 姓名= '" & RsRecordset!姓名 & "'", Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest12.EOF Then
GoTo Line123:
Else
xlsWst.Range("c" & i) = Rest12!金额
End If
Line123:
'Line44:
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
RsRecordset.MoveNext
Loop
Else
Do Until Rs.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rs!姓名
xlsWst.Range("c" & i) = Rs!净增减
Dim Rest As ADODB.Recordset
Set Rest = New ADODB.Recordset
Rest.Open "Select * from 起初余额表 where 姓名= '" & Rs!姓名 & "'", Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest.EOF Then
GoTo line2:
Else
xlsWst.Range("c" & i) = Rs!净增减 + Rest!金额
End If
'Line3:
Dim Rs2 As ADODB.Recordset
Set Rs2 = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 姓名='" & Rest!姓名 & "' and 姓名 in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "# ) and 日期=#" & frmMain.DTPicker1.Value & "# GROUP BY 姓名"
Rs2.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rs2.EOF Then
GoTo line2:
Else
xlsWst.Range("d" & i) = Rs2!增加
xlsWst.Range("e" & i) = Rs2!减少
'xlsWst.Range("g" & i) = IIf(IsNull(Rs2!事由), "", Rs2!事由)
End If
line2:
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
Dim Rst1 As ADODB.Recordset
Set Rst1 = New ADODB.Recordset
Rst1.Open "Select Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 日期=#" & frmMain.DTPicker1.Value & "# and 姓名 ='" & Rs!姓名 & "' GROUP BY 姓名 order by 姓名 ", Cn, adOpenKeyset, adLockReadOnly, adCmdText
If Rst1.EOF Then
GoTo line1:
End If
xlsWst.Range("d" & i) = IIf(IsNull(Rst1!增加), 0, Rst1!增加)
xlsWst.Range("e" & i) = IIf(IsNull(Rst1!减少), 0, Rst1!减少)
'xlsWst.Range("g" & i) = IIf(IsNull(Rst1!事由), "", Rst1!事由)
line1:
Rs.MoveNext
i = i + 1
Loop
Rs.Close
'结束 End If
End If
Dim Rest1 As ADODB.Recordset
Set Rest1 = New ADODB.Recordset
strSQL = "Select * from 起初余额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "#)"
Rest1.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest1.EOF Then
GoTo Line4:
End If
Do Until Rest1.EOF
DoEvents
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rest1!姓名
xlsWst.Range("c" & i) = Rest1!金额
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rest1.MoveNext
Loop
Line4:
Dim Rs22 As ADODB.Recordset
Set Rs22 = New ADODB.Recordset
strSQL = "Select 姓名 ,Sum(本期增加) as 增加,Sum(本期减少) as 减少 from 本期发生额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期<#" & frmMain.DTPicker1.Value & "# ) and 姓名 not in ( Select 姓名 from 起初余额表 ) and 日期=#" & frmMain.DTPicker1.Value & "# GROUP BY 姓名"
Rs22.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rs22.EOF Then
GoTo Line22:
End If
Do Until Rs22.EOF
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rs22!姓名
xlsWst.Range("d" & i) = IIf(IsNull(Rs22!增加), 0, Rs22!增加)
xlsWst.Range("e" & i) = IIf(IsNull(Rs22!减少), 0, Rs22!减少)
'xlsWst.Range("g" & i) = IIf(IsNull(Rs22!事由), "", Rs22!事由)
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rs22.MoveNext
Loop
'姓名 不在 本期发生额表
Dim Rest131 As ADODB.Recordset
Set Rest131 = New ADODB.Recordset
strSQL = "Select * from 起初余额表 where 姓名 not in ( Select distinct 姓名 from 本期发生额表 where 日期=#" & frmMain.DTPicker1.Value & "# or 日期<#" & frmMain.DTPicker1.Value & "#) and 姓名 in (Select 姓名 from 起初余额表 ) "
Rest131.Open strSQL, Cn, adOpenStatic, adLockReadOnly, adCmdText
If Rest131.EOF Then
GoTo Line22:
End If
Do Until Rest131.EOF
xlsWst.Range("a" & i) = i - 4
xlsWst.Range("b" & i) = Rest131!姓名
xlsWst.Range("c" & i) = Rest131!金额
xlsWst.Range("f" & i) = "=c" & i & "+d" & i & "-e" & i
i = i + 1
Rest131.MoveNext
Loop
'直接转到
GoTo Line22:
'如果不是这样
Line22:
xlsWst.Range("b" & i + 1) = "合 计："
xlsWst.Range("c" & i + 1) = "=sum(c5:c" & i & ")"
xlsWst.Range("d" & i + 1) = "=sum(d5:d" & i & ")"
xlsWst.Range("e" & i + 1) = "=sum(e5:e" & i & ")"
xlsWst.Range("f" & i + 1) = "=sum(f5:f" & i & ")"
xlsWst.Range("a" & i + 2 & ":g" & i + 2).Merge
xlsWst.Range("a" & i + 2) = "单位负责人：xxx 财务负责人：xxx 填表人：xxx"
xlsWst.Columns.AutoFit
xlsApp.Visible = True
Set xlsApp = Nothing
End Sub
来源: http://www.programbbs.com/bbs/announce.asp?boardid=21