[已解决]请老师帮我优化下这个汇总代码！！！

excel6699 · 发表于 2012-10-22 11:42

基础资料数据表.rar (15.37 KB, 下载次数: 9)

hwc2ycy · 发表于 2012-10-22 12:18

Private Sub CommandButton1_Click()
Dim Nowbook As Workbook
Dim ShName As Variant
Dim Arr As Variant
Dim myNewWorkbook As Integer
Dim intRow As Integer, t As Single
Dim ARow As Integer
Dim sWBName
'关闭刷屏
Application.ScreenUpdating = False
'禁止显示提示和警告消息
Application.DisplayAlerts = False
myNewWorkbook = Application.SheetsInNewWorkbook
ShName = Array("汇总数据")
Arr = Array("数据一", "数据二", "数据三", "数据四", "数据五", "数据六", "数据七", "数据八")
Application.SheetsInNewWorkbook = 1
sWBName = [a2]
Set Nowbook = Workbooks.Add
With Nowbook
With .Sheets(1)
ActiveWindow.DisplayGridlines = False '关闭网格线
.Name = ShName(0)
.Range("B4").Resize(1, UBound(Arr) + 1) = Arr
End With
End With
Set Nowbook = Nothing
Application.SheetsInNewWorkbook = myNewWorkbook
t = Timer
Dim cn As New ADODB.Connection, sql As String
'intRow = Sheet1.Range("B65536").End(xlUp).Row
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
sql = "select 数据一,数据二,数据三,数据四,数据五,数据六,数据七,sum(数据八) from [原表$B4:I" & intRow & "]" & _
"GROUP BY 数据一,数据二,数据三,数据四,数据五,数据六,数据七"
Sheets(1).Range("B5").CopyFromRecordset cn.Execute(sql)
cn.Close
Set cn = Nothing
'On Error Resume Next
'With Range("B5").Resize(K, 8) '绘制表格的问题2
With Range("B5").CurrentRegion
With Borders
LineStyle = xlContinuous
ColorIndex = 12
End With
End With
Debug.Print ThisWorkbook.Path & Application.PathSeparator & sWBName & ".xls"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & sWBName, FileFormat:=xlExcel8
'如果在03里，fileformat:=xlexcel7
ActiveWorkbook.Close True
End Sub

复制代码

hwc2ycy · 发表于 2012-10-22 12:20

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

基础资料数据表.rar (15.54 KB, 下载次数: 12)

excel6699 · 发表于 2012-10-22 12:41

hwc2ycy 发表于 2012-10-22 12:20

老师，刚下载了您给的附件。

在我的EXCEL2007中运行，无任何反应。

反而删掉了 ActiveWorkbook.Close True这一句运行就正常啦

但添加线框的那一段代码还是没有用。

这里给传一个关于自带画线框的样件，老师就知道明白我说的线框是什么意思啦。

自动画表格.rar (10.25 KB, 下载次数: 9)

hwc2ycy · 发表于 2012-10-22 12:57

画线框的我确实没看。
改一下FileFormat:=xlExcel7
我是在10上试的，不好意思。

excel6699 · 发表于 2012-10-22 13:04

hwc2ycy 发表于 2012-10-22 12:57
画线框的我确实没看。
改一下FileFormat:=xlExcel7
我是在10上试的，不好意思。

哈哈···改成这样就可以啦{:11:}

With Sheets(1).Range("B5").CurrentRegion
      With .Borders
            .LineStyle = xlContinuous
            .ColorIndex = 12
      End With
End With
谢谢老师帮忙~~！

老师我表格中的代码，能否帮我精简下？    {:34:}

hwc2ycy · 发表于 2012-10-22 13:26

呵呵。
你都会用SQL了，我还不会了，

		自动登录	找回密码
密码			注册

[已解决]请老师帮我优化下这个汇总代码！！！

相关帖子