Question

我是VBA的初学者，我在接受以下操作时遇到了麻烦。

创建名为Results1的新工作簿
在该目录中不以“结果”开头的所有文件中，获取单元格B11，然后获取B中的每第18行直到最后一行。
将所有（2）合并到Results1.xls列B

.*?\s

Path = "C:\Users\John\Desktop\"

Filename = Dir(Path & "*.xls")

Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

Answer 1

这是100％没有经过测试，所以我预计会有一些错误，因为我很快就会把它丢掉，然后发出肥胖的指法...但它绝对应该让你进入大球场。

在代码中使用F9来设置断点。还可以在“视图”＆gt;＆gt;中的“即时”和“本地”窗口上切换在VBE中下拉。这些将有助于在脚本运行时进行故障排除。

Sub mergeSheets()
    '1. Open a new workbook to receive the data also create a variable to tell which row we are writing to

    'Declare the variables we will be using here
    'This helps us troubleshoot since VBA will know what "Type" the variable is.
    Dim wbWrite As Workbook
    Dim rngWrite As Range

    Set wbWrite = Workbooks.Add
    Set rngWrite = wbWrite.Sheets("Sheet1").Range("B1")

    '2. Open a directory and loop through the excel sheets

    'Gonna need some more variables here
    Dim path As String
    Dim FileName As String
    Dim wbRead As Workbook
    Dim wsRead As Worksheet
    Dim intLastRow As Integer
    Dim intReadRow As Integer

    'Set the path and all that jazz
    path = "C:\Users\John\Desktop\"
    FileName = Dir(path & "*.xls")

    'Loop!
    Do While FileName <> ""

        'In all the files in that directory that don't begin with "Results"
        If Left(FileName, 7) <> "Results" Then
            'Open the workbook found and stick it in a variable so we can reference it
            Set wbRead = Workbooks.Open(FileName, , True)

            'Loop through the worksheets in the workbook
            ' by looping each worksheet in the workbook's Sheets collection
            For Each wsRead In wbRead.Sheets
                ', get cell B11 and every 18th row in B after that until last row.

                'Last row
                intLastRow = wsRead.Range(wsRead.Rows.Count).End(xlUp).Offset(-1).Row

                'Start at row 11 and step every 18 rows until you hit the last row
                For intReadRow = 11 To intLastRow Step 18

                    '3. Merge all of (2) into Results1.xls column B
                    rngWrite.value = wsRead.cells(intReadRow, 2).value

                    'go to the next row to write to
                    Set rngWrite = rngWrite.Offset(1)
                Next intReadRow
            Next wsRead

            'Close the workbook we are reading
            wbRead.Close
            Set wbRead = Nothing
        End If

        'Get the next file for the next iteration of this loop
        fileName = Dir
    Loop

    'We are done. Lets save this workbook
    wbWrite.SaveAs (path & "/Results.xls")

End Sub

Excel VBA从目录中的源中提取数据并合并到新创建的工作簿中

1 个答案: