VBA能让我的双手等到解放吗？谢谢！

一指禅62

1. Option Explicit
   
2. Dim cnn As Object, aa As String
   
3. 
   
4. Sub 报表整理()
   
5.     Dim Sh As Worksheet, Falg As Boolean
   
6.     aa = InputBox("请输入报表日期：", "编制报表", "1日")
   
7.     If StrPtr(aa) = 0 Then Exit Sub
   
8.     For Each Sh In Worksheets
   
9.         If Sh.Name = aa Then Falg = True: Exit For
   
10.     Next
    
11.     If Falg = False Then MsgBox "没有" & aa & "的工作表！", vbCritical: End
    
12.     Set cnn = CreateObject("adodb.connection")
    
13.     If Application.Version < 12 Then
    
14.         cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    
15.     Else
    
16.         cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    
17.     End If
    
18.     输出结果 "业务一部", "部门"
    
19.     输出结果 "业务二部", "部门"
    
20.     输出结果 "业务三部", "部门"
    
21.     输出结果 "第一级别", "级别"
    
22.     输出结果 "第二级别", "级别"
    
23.     输出结果 "第三级别", "级别"
    
24.     输出结果 "优秀", "级别"
    
25.     cnn.Close
    
26. End Sub
    
27. 
    
28. 
    
29. Private Sub 输出结果(ByVal myName As String, ByVal Colum As String)
    
30.     Dim Sh As Worksheet, SQL As String
    
31.     Set Sh = Sheets(myName)
    
32.     SQL = "Select 录音时间,姓名,年龄,地址,部门,级别 from [" & aa & "$] where " & Colum & "='" & myName & "'"
    
33.     Sh.Range("A2:F65536").Clear
    
34.     Sh.Range("A2").CopyFromRecordset cnn.Execute(SQL)
    
35.     Sh.Columns("A:A").NumberFormatLocal = "yyyy""年""m""月""d""日"";@"
    
36. End Sub

复制代码

一指禅62

一键完成  


报表整理.zip (25.19 KB, 下载次数: 18)

2017-4-27 12:01 上传

点击文件名下载附件

我是来讨说法的

要解放双手，需要去某宝买个某某杯就可以了，哈哈

colour250

蓝桥玄霜 发表于 2017-4-27 11:54
请见附件。

感谢老师的帮助，没想到居然还能做到 选择每日的工作表，太牛B太人性化了，谢谢！

colour250

每日报表（下拉）.rar (31.94 KB, 下载次数: 7)

2017-4-27 15:48 上传

点击文件名下载附件

一指禅62 发表于 2017-4-27 12:02
一键完成

感谢老师的帮助，一键完成功能太方便了，非常感谢！有个小小的请求，能不能将你的一键完成功能和10楼老师的  下拉列表选择功能   合在一块 ，这样就太完美了。再次谢谢！

喜有此李

论坛中果然有好心人啊。赞一个

colour250

一指禅62 发表于 2017-4-27 12:02
一键完成

数据无法进行叠加，操作2日的数据时会覆盖1日的数据。

colour250

每日报表28.rar (205.75 KB, 下载次数: 2)

2017-4-28 11:52 上传

点击文件名下载附件

蓝桥玄霜 发表于 2017-4-27 11:54
请见附件。

根据你提供的文件我对实际文件进行了更改，可是更改不成功，技术能力能限，请教老师可以帮我实际的改动吗？谢谢！能否进行整行的复制，包括将标注，格式之类的也一起复制过去呢，谢谢！

一指禅62

colour250 发表于 2017-4-28 10:49
数据无法进行叠加，操作2日的数据时会覆盖1日的数据。

你没要求叠加呀