Question

我在使用此宏时遇到了一些麻烦。我正在尝试让宏在文件名中搜索字符串“ Forcacc”，并将数据复制并粘贴到空白电子表格中，并且彼此重叠。

我有这段代码可用于完成类似的任务，并且试图更改此代码以使其无法正常工作。我认为我在循环中最挣扎，无法对其进行测试。这段代码是从别人的作品中复制过来的，我真的是编写VBA代码的初学者。

我认为评论很清楚，我在寻找什么。我认为原始工作代码在代码中的任何地方都没有“ Do”，但是如果我尝试将其遗漏，它现在会作为错误出现。它仍然显示“没有执行循环”错误。

Option Explicit
Sub CombineDataFiles()

Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
    LastDataRow As Long, LastDataCol As Long, _
    HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range

'initialize constants
HeaderRow = 2 'assume headers are always in row 1
LastOutRow = 1

'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)


    'What file to find
    Dim myPath
    myPath = "Q:\.All Kiwiplan SCS Plants\Plants\Aston\2018\2018-06\"   '<< folder/path
    Dim myFile
    myFile = Dir(myPath & "*ForcAcc*")

    'loop through all files
    Do Until myFile = ""
    For FileIdx = 1 To TargetFiles.SelectedItems.Count

    'open the file and assign the workbook/worksheet
    Set DataBook = myFile
    'Workbooks.Open (TargetFiles.SelectedItems(FileIdx))
    Set DataSheet = Sheets("PaperWidth Data Input")

    'identify row/column boundaries
    LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    'if this is the first go-round, include the header
    If FileIdx = 1 Then
        Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
    'if this is NOT the first go-round, then skip the header
    Else
        Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
    Loop
End If

    'copy the data to the outbook
    DataRng.Copy OutRng

    'close the data book without saving
    DataBook.Close False

    'update the last outbook row
    LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Next FileIdx

'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")

End Sub

Answer 1

Dir的基本轮廓是

Dim myFile
myFile = Dir(myPath & "*ForcAcc*")
Do Until myFile = ""
:::
:::
'Next FileIdx << take this out of where it is, and put in these two lines
    myFile = Dir    '<<< add this line to have myFile be set to the next file
Loop        '<<< add this line to Loop the do until blank

现在FileIdx上的内部循环应进行以下更改

        'Loop  <<remove this
    End If  '<< move this over one indent to right
Next FileIdx '<< add this here

VBA代码可拉出多个工作表并将其粘贴到主电子表格中

1 个答案: