Question

我一直在编辑/编写此代码以将多个工作簿合并为一个。但是我得到了一个没有Do＆＃34;编译错误。可能的重复并没有说明出了什么问题，只提供了一个新的代码，所以这不是我的问题的答案，而是一个解决方案。

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim OCol As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRangeCult As Range
    Dim DestRangeCult As Range
    Dim SourceRangeYield As Range
    Dim DestRangeYield As Range
    Dim SourceRangeLoc As Range
    Dim DestRangeLoc As Range
    Dim SourceRangeDRipe As Range
    Dim DestRangeDRipe As Range
    Dim LastRow As Integer
    Dim LastColumn As Integer
    Dim col As Integer

    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    FolderPath = "M:\My Documents\MSC Thesis\United Kingdom\Winter Barley\Merge excel\"

    NRow = 1
    OCol = 2
    OColD = OCol + 48


    FileName = Dir(FolderPath & "*.xl*")


        Do While FileName <> ""

            Set WorkBk = Workbooks.Open(FolderPath & FileName)


            SummarySheet.Range("A" & NRow).Value = FileName


            LastRow = ActiveSheet.UsedRange.Rows.Count
            LastColumn = ActiveSheet.UsedRange.Columns.Count

                For col = 2 To 49

                Set SourceRangeLoc = WorkBk.Worksheets(1).Range("A1:A" & LastRow)
                Set DestRangeLoc = SummarySheet.Range("C" & NRow)
                Set DestRangeLoc = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeCult = WorkBk.Worksheets(1).Range(OCol & "1:" & OCol & "1")
                Set DestRangeCult = SummarySheet.Range("B" & NRow)
                Set DestRangeCult = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeYield = WorkBk.Worksheets(1).Range(OCol & "2:" & OCol & LastRow)
                Set DestRangeYield = SummarySheet.Range("D" & NRow)
                Set DestRangeYield = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)

                Set SourceRangeDRipe = WorkBk.Worksheets(1).Range(OColD & "2:" & OColD & LastRow)
                Set DestRangeDRipe = SummarySheet.Range("E" & NRow)
                Set DestRangeDRipe = DestRange.Resize(SourceRangeLoc.Rows.Count, 1)


                DestRangeCult.Value = SourceRangeCult.Value

                Exit For

                NRow = NRow + DestRange.Rows.Count
                OCol = OCol + 1

            WorkBk.Close savechanges:=False

            FileName = Dir()

        Loop

    SummarySheet.Columns.AutoFit

End Sub

Answer 1

您的内部For循环没有结束表达式。 Exit For用于打破循环 - 说明常规结尾，只需使用Next。

循环无法识别Do

1 个答案: