将数据从 excel-files 的文件夹导入到特定的 excel-file 进行分析

Question

我正在做一个项目，我应该从每周报告（excel 文档）中收集特定的 table 数据，数据按行排序，每行包含日期、分钟数、代码 (1-7) 和评论。

我希望将报告中的每一行导入现有的 excel-file("Mother-file")，稍后将用于 analysis-purposes。

示例：假设每个周报有 2 行数据（这会很谨慎）。一个月后，我将收到 4 份报告，这些报告应该会在我的 "mother-file".

中产生 8 行

这里的挑战是让这件事自动化。我已经知道一种将这些数据输入 "mother-file" 的简单方法，但这是一项我希望自动化的手动任务。

到目前为止，在我编辑 excel-file (140923.xlsx)（日期）的名称之前，我一直在使用类似下面的命令，并且基本上复制它几次。

='F:\- RANHEIM\MPM\Bearbeidet resultatservice\[140923.xlsx]Sammendrag'!$B

所以我认为也许最好的办法是 command/code 将每周报告 (excel-file) 中 table 中的每一行导入特定文件夹中.甚至可能是 command/code 用于删除 "mother-file" 中未使用的行，这些行来自每周报告中的空行。

要检索的数据实际上是三种不同类型的数据，必须在关联中看到它们。这让我想到了下一个问题： - 我是否必须制作三个 "SourceRange" 来收集三种数据类型？或者我可以在母文件中收集并保存图片中所示的整行吗？

Answer 1

这是我用的。我已经标记了您需要更改的所有区域，以便根据您的需要对其进行个性化设置。

Sub MergeAllWorkbooks()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim OldName As String, NewName As String

'***Change this to the path\folder location of your files.***
MyPath = "C:\Folder\Path"

' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
End If

' If there are no Excel files in the folder, exit.
On Error GoTo ExitTheSub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
    Exit Sub
End If
On Error GoTo 0

' Fill the myFiles array with the list of Excel files in the search folder.
FNum = 0
Do While FilesInPath <> ""
    FNum = FNum + 1
    ReDim Preserve MyFiles(1 To FNum)
    MyFiles(FNum) = FilesInPath
    FilesInPath = Dir()
Loop


' Loop through all files in the myFiles array.
If FNum > 0 Then
    For FNum = LBound(MyFiles) To UBound(MyFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
        On Error GoTo 0

        If Not mybook Is Nothing Then
            On Error Resume Next

            '***Set this to the name or number of the worksheet the data will be put.***
            Set BaseWks = ThisWorkbook.Sheets("SheetName")
            '***Change this range to fit your own needs. This is where it will look for the data.***
            With mybook.Worksheets(1)
                Set sourceRange = .Range("A2:M10000")
            End With
            If Err.Number > 0 Then
                Err.Clear
                Set sourceRange = Nothing
            End If
            On Error GoTo 0
            rnum = BaseWks.Range("A" & Rows.Count).End(xlUp).Row + 1

            If Not sourceRange Is Nothing Then

                SourceRcount = sourceRange.Rows.Count

                    '***Set the destination range.***
                    Set destrange = BaseWks.Range("A" & rnum)

                    ' Copy the values from the source range
                    ' to the destination range.
                    With sourceRange
                        Set destrange = destrange. _
                                        Resize(.Rows.Count, .Columns.Count)
                    End With
                    destrange.Value = sourceRange.Value

            End If
            BaseWks.Columns.AutoFit
            Set sourceRange = Nothing
            Set destrange = Nothing
            Set BaseWks = Nothing



            With mybook
                '***Set the folder path for OldName to folder the file is located. Should be _
                the same as MyPath in this case.***
                OldName = "C:\Folder\Path\" & mybook.Name
                '***Set the folder path for NewName where you would like to move the files _
                once you've gotten the data from them. I generally just make another folder _
                inside of the first and call it "Used"***
                NewName = "C:\Folder\Path\Used\" & mybook.Name
                mybook.Close (False)
                Name OldName As NewName
            End With
        End If
    Next FNum
End If

ExitTheSub:
    On Error Resume Next
    ThisWorkbook.Save
    On Error GoTo 0

End Sub

Answer 2

在不使用 VBA 的情况下，我最接近你想要完成的是使用 INDIRECT 函数：

步骤 1：让用户在单元格 A1 中输入报表的 sheet 名称。我建议使用数据验证在单元格上显示输入消息，以防其他人使用该文件：

步骤 2：在单元格 B1 中，输入以下公式：

="'F:\- RANHEIM\MPM\Bearbeidet resultatservice\["&A1&"]Sammendrag'!A1"

它将return这样：

步骤 3：在单元格 A2 中，输入以下公式：

=IF(OFFSET(INDIRECT($B),ROW(A2)-1,COLUMN(A2)-1)=0,"",OFFSET(INDIRECT($B),ROW(A2)-1,COLUMN(A2)-1))

第 4 步：向下和横向拖动公式，以便从报表中拉入所有单元格。

第五步：INDIRECT函数需要引用的sheet开放使用。如果您希望报表中的信息在报表关闭后保留在母文件中，只需复制使用的范围，在同一范围内执行选择性粘贴，然后 select "Values"。根据需要添加任何 headers 并删除输入消息。

第 6 步：如果要删除空行，则可以根据 A 列（日期列）对范围进行排序。这会将所有空行放在 sheet 的底部；有效地将它们从您的报告中删除。

将数据从 excel-files 的文件夹导入到特定的 excel-file 进行分析

Importing data from a folder of excel-files to a specific excel-file for analysis

excel

automation