Excel VBA：在循环中select一行

我有一个包含许多xls文件的源文件夹。 我想创build一个主文件 – 从给定源文件中的所有文件中将所有信息收集到一个数据库中。

以下代码在主文件中创build2列，并从给定源文件（一个文件）中input2个值：

Sub getData() Dim XL As Excel.Application Dim WBK As Excel.Workbook Dim scrFile As String Dim myPath As String myPath = ThisWorkbook.path & "\db\" 'The source folder scrFile = myPath & "1.xlsx" 'Select first file ' Sheet name in the master file is "Sh" ThisWorkbook.Sheets("Sh").Range("A1").Value = "Column 1" ThisWorkbook.Sheets("Sh").Range("B1").Value = "Column 2" Set XL = CreateObject("Excel.Application") Set WBK = XL.Workbooks.Open(scrFile) ThisWorkbook.Sheets("Sh").Range("A2").Value = WBK.ActiveSheet.Range("A10").Value ThisWorkbook.Sheets("Sh").Range("B2").Value = WBK.ActiveSheet.Range("C5").Value WBK.Close False Set XL = Nothing Application.ScreenUpdating = True End Sub 

现在，我想遍历所有文件，并将每个文件中的单元格“A10”和“C5”的值保存在一个数据库中，因此循环应select下一行以保存新值。

我有一个想法如何遍历所有文件，但不知道如何切换到下一行：

 scrFile = Dir(myPath & "*.xlsx") Do While scrFile <> "" Set XL = CreateObject("Excel.Application") Set WBK = XL.Workbooks.Open(scrFile) ' Here should be the code to save the values of A10 and C5 of the given file 'in the loop in next available row of the master file. WBK.Close False Set XL = Nothing scrFile = Dir Loop 

任何帮助将不胜感激！ 🙂

Answer 1

为了简单，只需使用一个计数器：

 scrFile = Dir(myPath & "*.xlsx") n = 1 ' skip the first row with headers Do While scrFile <> "" n = n + 1 Set XL = CreateObject("Excel.Application") Set WBK = XL.Workbooks.Open(scrFile) ' save the values of A10 and C5 of the given file in the next row ThisWorkbook.Sheets("Sh").Range("A" & n).Value = WBK.ActiveSheet.Range("A10").Value ThisWorkbook.Sheets("Sh").Range("B" & n).Value = WBK.ActiveSheet.Range("C5").Value WBK.Close False Set XL = Nothing scrFile = Dir Loop msgbox n & " files imported." 

顺便说一句，你不需要启动第二个Excel实例（CreateObject（“Excel.Application”））只是为了打开第二个工作簿。 这会使你的代码变慢。 只要打开，阅读并closures它。 通过ThisWorkbook解决您的主工作簿，但分配一个variables：

 Dim masterWB As Excel.Workbook set masterWB = ThisWorkbook ... masterWB.Sheets("Sh").Range("A" & n).Value = WBK.ActiveSheet.Range("A10").Value 

Answer 2

您需要重新计算End()函数循环中的最后一行。

像范围.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)

或者有一个整数.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row

---

试试这个：

 Sub getData() Application.ScreenUpdating = False Dim XL As Excel.Application, _ WBK As Excel.Workbook, _ MS As Worksheet, _ scrFile As String, _ myPath As String 'Sheet name in the master file is "Sh" Set MS = ThisWorkbook.Sheets("Sh") 'The source folder myPath = ThisWorkbook.Path & "\db\" MS.Range("A1").Value = "Column 1" MS.Range("B1").Value = "Column 2" Set XL = CreateObject("Excel.Application") scrFile = Dir(myPath & "*.xlsx") Do While scrFile <> "" Set WBK = XL.Workbooks.Open(scrFile) ' Here should be the code to save the values of A10 and C5 of the given file 'in the loop in next available row of the master file. With MS .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Value = WBK.ActiveSheet.Range("A10").Value .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Value = WBK.ActiveSheet.Range("C5").Value End With WBK.Close False scrFile = Dir Loop XL.Quit Set XL = Nothing Set MS = Nothing Set WBK = Nothing Application.ScreenUpdating = True End Sub 

Answer 3

我其实有一个代码，将循环通过每个文件，并将代码存入您的主文件。 您也可以select目标文件夹的目录。

 Sub GatherData() Dim sFolder As String Application.ScreenUpdating = True With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = Application.DefaultFilePath & "\" .Title = "Please select a folder..." .Show If .SelectedItems.Count > 0 Then sFolder = .SelectedItems(1) & "\" Else Exit Sub End If End With Call Consolidate(sFolder, ThisWorkbook) End Sub Private Sub Consolidate(sFolder As String, wbMaster As Workbook) Dim wbTarget As Workbook Dim objFso As Object Dim objFiles As Object Dim objSubFolder As Object Dim objSubFolders As Object Dim objFile As Object Dim ary(3) As Variant Dim lRow As Long 'Set Error Handling On Error GoTo EarlyExit 'Create objects to enumerate files and folders Set objFso = CreateObject("Scripting.FileSystemObject") Set objFiles = objFso.GetFolder(strFolder).Files Set objSubFolders = objFso.GetFolder(strFolder).subFolders 'Loop through each file in the folder For Each objFile In objFiles If InStr(1, objFile.Path, ".xls") > 0 Then Set wbTarget = Workbooks.Open(objFile.Path) With wbTarget.Worksheets(1) ary(0) = .Range("B8") 'here you can change the cells you need the data from ary(1) = .Range("B12") ary(2) = .Range("B14") End With With wbMaster.Worksheets(1) lRow = .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0).Row 'here you can change the row the data is deposited in .Range("E" & lRow & ":G" & lRow) = ary End With wbTarget.Close savechanges:=False End If Next objFile 'Request count of files in subfolders For Each objSubFolder In objSubFolders Consolidate objSubFolder.Path, wbMaster Next objSubFolder EarlyExit: 'Clean up On Error Resume Next Set objFile = Nothing Set objFiles = Nothing Set objFso = Nothing On Error GoTo 0 End Sub