终于用VBA解决了一直以来统计这个大麻烦

每次各地方要数据的时候总是我最受虐的时候.

因为各地方的报表都是以单个的EXCEL文件的形式上报的,缺乏整体的汇总整理,一旦要数据,要么手工加和,要么用Excel的公式完成,随着需要统计的时间段的增加,工作量也成倍增加.

这次一次让我统计2年半的数据我终于出离的崩溃了...于是我终于下定决心要写个程序来搞定这该死的机械劳动.

虽然我本意是想用Python来分析Excel文件然后加入到MySQL数据库中,但是后来发现这样太绕弯子了,因为1.Python本身对Excel进行分析就不是很得力.2.输入进MySQL以后就算是调数据要么还要写一个GUI让它把数据掉出来,要么还是需要手工SQL...无疑是增加了麻烦绕了圈子.

所以看来微软的东西还是要用微软自己的软件来搞定,Access不就是这样一个东西么?

作为一个相当简单的数据库,Access提供了我最需要的功能...那就是和Excel的相当简单的数据互通,起码从Access到Excel是相当简单的..而我需要解决的难题就是怎么把Excel中的数据,准确的说是我想要的那一部分数据导入进来.而我面对的就是600多个Excel文件...

因为之前从未接触过Vba,不得不从头学起,不过好在不难就是了,直接到网上找了几个例子稍稍修修改改了一下.

Function testttt(folderspec As String, tratablename As String)
    Dim objRs As New ADODB.Recordset
    Dim objFields As ADODB.Fields
    Dim myArray() As String  '存放access表中字段名
    Dim tempArray()  As String      '存放新增的字段名
    Dim fs, f, f1, fc, s, t, u, a, b, c, intloop, t2, t3, t4, t5, t6, t7, t8, t9, fn
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(folderspec) Then
        MsgBox "指定的文件夹不存在!"
        Exit Function
    End If
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    b = 0  '记录导入的文件数量
    c = 0  'access表中应有的字段数量
    u = 1
    Dim xlApp As Excel.Application '也可以用Excel.Application,用object就不要引用Microsoft Excel 11.0 Object Library
    Debug.Print "目录下总共有" & fc.Count & "个文件!"
    For Each f1 In fc
        If LCase(Right(f1.Name, 3)) = "xls" Then
            fn = Right(Left(f1.Name, 2), 3)
            If fn <> "T1" And fn <> "T2" Then
                    
                'Set xlApp = New Excel.Application
                Set xlApp = CreateObject("Excel.Application")
                xlApp.Workbooks.Open (folderspec & "\" & f1.Name)
                xlApp.Visible = False '隐藏Excel应用程序窗口
                xlApp.Sheets(1).Activate
                xlApp.Sheets(1).Range("A1").Select
                Set rs = CurrentDb.OpenRecordset("select * from 统计表")
                rs.AddNew
                rs("area") = fn
                rs("fs") = xlApp.Worksheets(1).Range("G9").Value
                rs("ss") = xlApp.Worksheets(1).Range("G11").Value
                rs("mulit") = xlApp.Worksheets(1).Range("G19").Value
                rs("time") = tratablename
                rs.Update
                xlApp.Workbooks(f1.Name).Close Savechanges:=False
                xlApp.Quit
                Set xlApp = Nothing
            End If
        End If
    Next
    Set rs = Nothing
    Exit Function
End Function

大概意思也就是遍历了一个文件夹内的全部XLS文件,然后取出文件名,放入一个字段,取出各个字段所需要的值放入它们对应的位置...

好吧,其实之前一直卡得比较厉害的是我根本忘了载入对应的类...OTL