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

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

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

示例：假设每个周报告都有两行数据（这会很警惕）。 一个月后，我会有4个报告，这应该导致我的“母亲档案”中有8行。

这里的挑战是使这个事情自动化。 我已经知道将这些数据input到“母文件”中的一种简单方法，但是这是一个手动任务，我希望自动化。

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

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

所以我想，也许最好的事情将是一个命令/代码，从每周报告（excel文件），在特定的文件夹中导入表中的每一行。 甚至可能是一个命令/代码，用于删除每周报告中来自空行的“母文件”中未使用的行。

要检索的数据实际上是三种不同types的数据，必须在相关性中看到。 这使我想到了下一个问题： – 我将不得不做三个“SourceRange”来收集三个数据types？ 或者我可以收集并保存图片中显示的整行，在母文件中？

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 ：让用户将报表的表格名称input单元格A1。 我build议使用数据validation在单元格上显示input消息，以防其他人使用该文件：

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

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

它会返回这个：

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

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

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

步骤5 ： INDIRECTfunction要求参考表单打开使用。 如果要在报告closures后将报告中的信息保留在母文件中，只需复制已使用的范围，在相同的范围内执行select性粘贴，然后select“值”。 添加任何你想要的标题，并删除input消息，如有必要。

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