提取不同文件夹下的指定单元格内容

@桃花鼠

      一个汇总文件夹下面有好多个子文件夹,每个子文件夹按照日期命名的,且里面有一个Excel文档,里面记录了许多数据.现在想要汇总所有Excel文档中“日期”单元格的内容，如果一个文件一个文件的打开再输入新的表格中，工作量太大，这个问题怎么解决呢？按下组合键“Alt+F8”打开宏窗口，输入宏名“另存为TXT文件”，点击“创建”按钮，在打开的VBA窗口中输入如下代码：

Sub Macro1()

    Dim Fso As Object, sFileType$, i&, a, arrf$(), brr(), m&

    Dim cnn As Object, rs As Object, SQL$

    Application.ScreenUpdating = False

    a = Range("A1:C1")

    Set Fso = CreateObject("Scripting.FileSystemObject")

    sFileType = "*.xls"

    Call GetFiles(ThisWorkbook.Path, sFileType, Fso, arrf, m)

    ReDim brr(1 To m, 1 To 3)

    For i = 1 To m

        Set cnn = CreateObject("adodb.connection")

        Set rs = CreateObject("adodb.Recordset")

        cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='excel 8.0;hdr=no';Data Source=" & arrf(i)

        Set rs = cnn.OpenSchema(20)

        Do Until rs.EOF

            If rs.Fields("TABLE_TYPE") = "TABLE" Then

                s = Replace(rs("TABLE_NAME").Value, "'", "")

                If Right(s, 1) = "$" Then

                    brr(i, 1) = cnn.Execute("select f1 from [" & s & "b4:b4]")(0)

                    brr(i, 2) = cnn.Execute("select f1 from [" & s & "b7:b7]")(0)

                    brr(i, 3) = cnn.Execute("select f1 from [" & s & "d18:d18]")(0)

                    Exit Do

                End If

            End If

            rs.MoveNext

        Loop

    Next

    ActiveSheet.UsedRange.Offset(1).ClearContents

    [a2].Resize(i - 1, 3) = brr

    Set Fso = Nothing

    rs.Close

    Set rs = Nothing

    cnn.Close

    Set cnn = Nothing

    Application.ScreenUpdating = True

End Sub

Private Sub GetFiles(ByVal sPath$, ByVal sFileType$, ByRef Fso As Object, ByRef arr$(), ByRef m&)

    Dim SubFolder As Object

    Dim File As Object

    For Each File In Fso.GetFolder(sPath).Files

        If File.Name Like sFileType Then

            If File.Name <> ThisWorkbook.Name Then

                m = m + 1

                ReDim Preserve arr(1 To m)

                arr(m) = File

            End If

        End If

    Next

    For Each SubFolder In Fso.GetFolder(sPath).SubFolders

        Call GetFiles(SubFolder.Path, sFileType, Fso, arr, m)

    Next

    Set File = Nothing

    Set SubFolder = Nothing

End Sub

      最后，为新增加的宏命令指定一个按钮，今后点击该按钮即可自动汇总提取不同文件夹下的指定单元格内容，代码中的单元格、文件名称等要根据实际情况自行修改。

     董师傅点评：要使用宏功能，需要在“工具”→“宏” →“安全性”中降低安全级别。

教师

为数学题输入循环小数

@笑笑鼠

      在制作数学单元练习题或者数学试卷时，有时候要输入循环小数，这个怎么输入呢？假设要在Word文档中输入“1.23”，数字3要循环，那么鼠标选中数字3，点击“格式”，选择“中文版式”，再选择“拼音指南”，在“拼音文字”处点击一下，再点击搜狗输入法的软键盘按钮，弹出软键盘，在其中选择“.”符号即可。 

     董师傅点评：除了用这个方法，还可以用公式编辑器来完成，这个更加专业一点，不过操作要复杂一些。

请关注董师傅微博

      怎么办公最有效率？怎么办公最轻松？来看看董师傅的珍藏，相信你一定会有意外的收获。顺带也可以听听董师傅的理财心得，倾听财富的声音！同时有问题也可以微博私信董师傅。