Question

我对脚本编程比较陌生，因此来到这里请求帮助我构建一个excel宏。我目前正在开发一个excel文件来加速数据捕获和验证。我无法解决如何获取实际数据的问题。

我目前有一个包含所有文件夹和Excel文件的驱动器：

Y:\Audit\Accounting_Data\XXXXX_Company_Names\07 Jul 2013\XXXXX.xls

对我来说，第一个问题是每个公司都以不同的文件命名约定发送文件。有些日期是数字值，而其他日期有字母数字数据（不是相同的顺序，有些是DD / MM / YYYY，有些则是MMMM / DD / YYYY）。我无法修改文件命名约定，因为它们也被共享给其他服务，最重要的是我只能读取这些文件。

第二个问题是每家公司都不会在同一天生成文件。有些人每天都会生成审核文件，有些只在工作日生成（周末的那些文件会在周一早上创建并发送给我）＆gt;＆gt;我正在考虑使用object.fso按照date.created标准获取最后10个文件，并且当它找不到更多文件时，excel停止搜索//之前提到的问题是某些文件是在同一天创建的。

此外，我正在尝试实现循环功能（当它碰到空白单元时停止），因为可以在sheet1中定义的列表中添加或删除公司。

我想要的是让excel转到当前月份文件夹并打开10个以前的Excel文件并复制当前工作表中特定单元格的粘贴数据的方法。

这就是我现在想出的：

单元格A4：A12 =文件路径（即Y：\ Audit \ Accounting_Data \ XXXXX_Company_Names）

var1=file path
var2=month (numeric)
var3=month
var4=year

Range (a4:a50)    
Do Loop till blank cell in Range (a4:a50)
 If cell is not blank then
  goto "var1\var2+var3+var4\"

  Excel is now in Y:\Audit\Accounting_Data\XXXXX_Company_Names\07 Jul 2013\ (hopefully)

如何告诉excel打开相对于今天日期的前10个excel文件，如果找到更少或没有找到，则停止

 Copy Data 
 Paste Data

 Move to next line
   Repeat the Open 10 previous files / Copy / Paste

else when cell is blank

 stop

Answer 1

这样的事情对你有用。它应该遍历数组中的每个文件夹并获取存储在文件夹中的所有文件，按日期排序，打开最多10个文件并将每个文件复制到工作表中。

在本例中，我使用“Sheet1”作为工作表来复制所有数据，并使用名为“DateList”的工作表来存储所有文件路径并创建日期。

Sub Example()
    Dim DirList() As Variant
    Dim Path As Variant
    Dim fso As Object
    Dim dt As Date
    Dim CurrFile As String
    Dim RowOffset As Long

    DirList = Array("C:\Test\", "C:\Test - Copy\")          'Create list of folders to search
    Set fso = CreateObject("Scripting.FileSystemObject")    'Create file system object
    Sheets("DateList").Cells.Delete
    Sheets("DateList").Range("A1").Value = "Path"
    Sheets("DateLIst").Range("B1").Value = "Date Created"

    'Loop through every directory in the list
    For Each Path In DirList()
        CurrFile = Dir(Path)

        'For each file in the current directory
        Do While CurrFile <> ""
            'Get the files date created
            dt = fso.GetFile(Path & CurrFile).DateCreated

            'Add the file data to a "DateList"
            Sheets("DateList").Cells(Sheets("DateList").UsedRange.Rows.Count + 1, 1).Value = Path & CurrFile
            Sheets("DateList").Cells(Sheets("DateList").UsedRange.Rows.Count, 2).Value = Format(dt, "yyyymmdd")

            CurrFile = Dir
        Loop

        Sheets("DateList").Select
        'Sort Files
        With ActiveWorkbook.Worksheets("DateList").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B1"), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlDescending, _
                            DataOption:=xlSortNormal
            .SetRange Sheets("DateList").UsedRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        Sheets("Sheet1").Select
        'Get up to 10 files
        For i = 2 To 11
            If Sheets("DateList").Cells(i, 1).Value = "" Then
                Exit For
            End If

            'Open the file, copy it to the bottom of the data on Sheet1
            '***NOTE*** THIS ASSUMES SHEET1 STARTS OFF BLANK
            Workbooks.Open Sheets("DateList").Cells(i, 1).Value
            ActiveSheet.UsedRange.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(1 + RowOffset, 1)
            RowOffset = RowOffset + ActiveSheet.UsedRange.Rows.Count
            ActiveWorkbook.Close
        Next

        Sheets("DateList").Select
        Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 2)).Delete
        Sheets("Sheet1").Select
    Next
End Sub

文件打开帮助 - Excel宏

1 个答案: