将数据从excel文件夹导入特定的excel文件进​​行分析

Question

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

我希望将支持中的每一行导入到现有的excel文件（“母文件”）中，以后将用于分析目的。

示例：假设每周报告有2行数据（这将是谨慎的）。一个月后，我将有4个报告，这些报告应该在我的“母文件”中产生8行。

这里的挑战是让这件事情自动化。我已经知道将这些数据输入“母文件”的简单方法，但这是一项手动任务，我希望自动完成。

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

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

所以我认为最好的事情可能是从特定文件夹中的每周报告（excel-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中。我建议使用数据验证在单元格上显示输入消息，以防其他人使用该文件：

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

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

它会返回：

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

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

第4步：向下拖动公式，以便从报告中提取所有单元格。

第5步：INDIRECT函数要求引用的工作表可以使用。如果您希望报告关闭后报告中的信息保留在母文件中，只需复制使用的范围，在同一范围内执行“选择性粘贴”，然后选择“值”。添加所需的任何标题，并在必要时删除输入消息。

第6步：如果要删除空行，则可以根据列A（日期列）对范围进行排序。这将在工作表的底部放置任何空白行;有效地从报告中删除它们。