[已解决]求助生成时能否自动生成序号和在生成最后一行生成统计金额

qinhuan66

求助生成时能否自动生成序号和在生成最后一行生成统计金额  谢谢

求助1.rar (35.37 KB, 下载次数: 26)

2014-11-12 21:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-11-13 08:05

1. Private Sub CommandButton1_Click()
   
2.     Const adUseClient = 3
   
3.     Const adModeRead = 1
   
4.     Dim AdoConn As Object, AdoRst As Object
   
5.     Dim strConn$, strSQL$, strFullname$, strCondition$
   
6.     Dim blnHasHeader As Boolean
   
7. 
   
8.     On Error GoTo ErrorHandler
   
9.     blnHasHeader = True
   
10.     strFullname = ThisWorkbook.FullName
    
11. 
    
12.     Set AdoConn = CreateObject("ADODB.Connection")
    
13.     strSQL = "select 定点医疗机构名称,分类,发生人次,总费用,统筹支付,IC卡支付,公务员补助,大额补助,扣减费用,实际应付 from [数据库$a1:o] "
    
14. 
    
15.     If Len(Range("b2").Value) Then
    
16.         strCondition = " 定点医疗机构名称='" & Range("b2").Value & "' and "
    
17.     End If
    
18. 
    
19.     If Len(Range("f2").Value) Then
    
20.         strCondition = strCondition & "报表时间=#" & Range("f2").Value & "# and "
    
21.     End If
    
22. 
    
23.     If Len(Range("j2").Value) Then
    
24.         strCondition = strCondition & "报表类别='" & Range("j2").Value & "' and "
    
25.     End If
    
26. 
    
27.     If Len(strCondition) Then
    
28.         strSQL = strSQL & "where " & Left(strCondition, Len(strCondition) - 5)
    
29.     End If
    
30. 
    
31.     Select Case Application.Version
    
32.     Case "14.0", "15.0", "12.0"
    
33.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
34.                   strFullname & "';Extended Properties='Excel 12.0;HDR=" & blnHasHeader & ";imex=1';"
    
35.     Case Else
    
36.         strConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
37.                   "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=" & blnHasHeader & ";imex=1';"
    
38.     End Select
    
39. 
    
40.     'Debug.Print strConn
    
41. 
    
42.     With AdoConn
    
43.         .CommandTimeout = 5
    
44.         .ConnectionTimeout = 5
    
45.         .CursorLocation = adUseClient
    
46.         .Mode = adModeRead
    
47.         .ConnectionString = strConn
    
48.         .Open
    
49.     End With
    
50. 
    
51.     'MsgBox strSQL
    
52.     Application.ScreenUpdating = False
    
53.     Dim lRow&
    
54.     Set AdoRst = AdoConn.Execute(strSQL)
    
55.     lRow = Cells(Rows.Count, 2).End(xlUp).Row
    
56. 
    
57.     If lRow > 3 Then
    
58.         Range("a4:k" & lRow).Clear
    
59.     End If
    
60. 
    
61.     If AdoRst.RecordCount > 0 Then
    
62.         Range("b4").CopyFromRecordset AdoRst
    
63.         MsgBox "一共查询到了 " & AdoRst.RecordCount & " 条记录"
    
64.         Range("a4").Resize(AdoRst.RecordCount, 11).Borders.LineStyle = 1
    
65.         Dim arr
    
66.         arr = Application.Evaluate("=row(a1:a" & AdoRst.RecordCount & ")")
    
67.         With Range("a4").Resize(AdoRst.RecordCount)
    
68.             .Value = arr
    
69.             .NumberFormat = "000"
    
70.         End With
    
71.     Else
    
72.         MsgBox "没有符合条件的记录"
    
73.     End If
    
74.     Application.ScreenUpdating = True
    
75.     AdoConn.Close
    
76.     Exit Sub
    
77. 
    
78. ErrorHandler:
    
79.     MsgBox Err.Number & vbCrLf & _
    
80.            Err.Description
    
81.     Application.ScreenUpdating = True
    
82.     Set AdoRst = Nothing
    
83.     Set AdoConn = Nothing
    
84. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

录个宏，A列序列号填充，自定义格式000

qinhuan66

hwc2ycy 发表于 2014-11-12 22:24
录个宏，A列序列号填充，自定义格式000

哦原来是那个方法。我以前做过不过生成以后有公式的

Excel学徒123

可以

hwc2ycy

合计可以搜下，貌似有相关的代码，公式好长呀。

qinhuan66

hwc2ycy 发表于 2014-11-12 23:03
合计可以搜下，貌似有相关的代码，公式好长呀。

好的。好像小写金额转大写金额录制宏录不了。还是算了。还是谢谢你一直以来的帮忙

hwc2ycy

1.     If AdoRst.RecordCount > 0 Then
   
2. 
   
3.         Range("b4").CopyFromRecordset AdoRst
   
4.         Application.ScreenUpdating = True
   
5. 
   
6.         MsgBox "一共查询到了 " & AdoRst.RecordCount & " 条记录"
   
7.         Range("a4").Resize(AdoRst.RecordCount, 11).Borders.LineStyle = 1
   
8.         Dim arr
   
9.         arr = Application.Evaluate("=row(a1:a" & AdoRst.RecordCount & ")")
   
10.         With Range("a4").Resize(AdoRst.RecordCount)
    
11.             .Value = arr
    
12.             .NumberFormat = "000"
    
13.     Else
    
14.         MsgBox "没有符合条件的记录"
    
15.     End If

复制代码

序号一段的代码，直接替换原有的那一段if adorst.recordcount那一段。

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Const adUseClient = 3
   
3.     Const adModeRead = 1
   
4.     Dim AdoConn As Object, AdoRst As Object
   
5.     Dim strConn$, strSQL$, strFullname$, strCondition$
   
6.     Dim blnHasHeader As Boolean
   
7. 
   
8.     On Error GoTo ErrorHandler
   
9.     blnHasHeader = True
   
10.     strFullname = ThisWorkbook.FullName
    
11. 
    
12.     Set AdoConn = CreateObject("ADODB.Connection")
    
13.     strSQL = "select 定点医疗机构名称,分类,发生人次,总费用,统筹支付,IC卡支付,公务员补助,大额补助,扣减费用,实际应付 from [数据库$a1:o] "
    
14. 
    
15.     If Len(Range("b2").Value) Then
    
16.         strCondition = " 定点医疗机构名称='" & Range("b2").Value & "' and "
    
17.     End If
    
18. 
    
19.     If Len(Range("f2").Value) Then
    
20.         strCondition = strCondition & "报表时间=#" & Range("f2").Value & "# and "
    
21.     End If
    
22. 
    
23.     If Len(Range("j2").Value) Then
    
24.         strCondition = strCondition & "报表类别='" & Range("j2").Value & "' and "
    
25.     End If
    
26. 
    
27.     If Len(strCondition) Then
    
28.         strSQL = strSQL & "where " & Left(strCondition, Len(strCondition) - 5)
    
29.     End If
    
30. 
    
31.     Select Case Application.Version
    
32.     Case "14.0", "15.0", "12.0"
    
33.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
34.                   strFullname & "';Extended Properties='Excel 12.0;HDR=" & blnHasHeader & ";imex=1';"
    
35.     Case Else
    
36.         strConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
37.                   "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=" & blnHasHeader & ";imex=1';"
    
38.     End Select
    
39. 
    
40.     'Debug.Print strConn
    
41. 
    
42.     With AdoConn
    
43.         .CommandTimeout = 5
    
44.         .ConnectionTimeout = 5
    
45.         .CursorLocation = adUseClient
    
46.         .Mode = adModeRead
    
47.         .ConnectionString = strConn
    
48.         .Open
    
49.     End With
    
50. 
    
51.     'MsgBox strSQL
    
52.     Application.ScreenUpdating = False
    
53.     Dim lRow&
    
54.     Set AdoRst = AdoConn.Execute(strSQL)
    
55.     lRow = Cells(Rows.Count, 2).End(xlUp).Row
    
56. 
    
57.     If lRow > 3 Then
    
58.         Range("a4:k" & lRow).Clear
    
59.     End If
    
60. 
    
61.     If AdoRst.RecordCount > 0 Then
    
62.         Range("b4").CopyFromRecordset AdoRst
    
63.         MsgBox "一共查询到了 " & AdoRst.RecordCount & " 条记录"
    
64.         Range("a4").Resize(AdoRst.RecordCount, 11).Borders.LineStyle = 1
    
65.         Dim arr
    
66.         arr = Application.Evaluate("=row(a1:a" & AdoRst.RecordCount & ")")
    
67.         With Range("a4").Resize(AdoRst.RecordCount)
    
68.             .Value = arr
    
69.             .NumberFormat = "000"
    
70.         End With
    
71.     Else
    
72.         MsgBox "没有符合条件的记录"
    
73.     End If
    
74.     Application.ScreenUpdating = True
    
75.     AdoConn.Close
    
76.     Exit Sub
    
77. 
    
78. ErrorHandler:
    
79.     MsgBox Err.Number & vbCrLf & _
    
80.            Err.Description
    
81.     Application.ScreenUpdating = True
    
82.     Set AdoRst = Nothing
    
83.     Set AdoConn = Nothing
    
84. End Sub

复制代码

张雄友

hwc2ycy 发表于 2014-11-13 08:05

至少一个参数没有指定值，请求。