Question

当我要求它添加大约200行的前两个文件中的信息时，下面的代码工作正常，但是如果我添加第三个，它会崩溃Excel。每次用户运行时，我都需要这个代码来组合40个文件。

我最初编写的文件是使用选择并在此处发现一条帖子说它可能会减速或导致崩溃，并将其重写为当前迭代，从程序中删除所有选择。

Public Sub ImportUpdates()
Dim ImportXL        As Workbook
Dim OpenFiles()     As Variant
Dim i               As Long
Dim r               As Long
Dim n               As Long
Dim Crntwrkbk       As String
Dim Crng            As Range
Dim Cloc            As Long



'Application.ScreenUpdating = False


Crntwrkbk = ThisWorkbook.Name


OpenFiles = Application.GetOpenFilename( _
Title:="Select File(s) To Import", _
MultiSelect:=True)

n = Application.CountA(OpenFiles)

For i = 1 To n
        Set ImportXL = Workbooks.Open(OpenFiles(i))

        ImportXL.Worksheets("Entries").Activate
        r = Cells(Rows.Count, "A").End(xlUp).Row
        Set Crng = Range(Cells(2, 1), Cells(r, 2))

        Crng.Copy

        Windows(Crntwrkbk).Activate
        Worksheets("Entries").Activate

        Cloc = Workbooks(Crntwrkbk).Worksheets("Entries").Range("A65536").End(xlUp).Offset(1).Row
        Worksheets("Entries").Range("A" & Cloc).PasteSpecial _
        Paste:=xlPasteValues

        Application.CutCopyMode = False

        ImportXL.Close True

Next i


'Application.ScreenUpdating = True
'Workbooks(Crntwrkbk).Activate

End Sub

任何帮助表示赞赏。

Answer 1

这是未经测试但看起来对我来说是正确的（尽管这可能是一个很好的学习练习，让你弄清楚它是否工作正常）。

它是一种使用数组，动态范围和后期绑定来移动数据的方法。此外，它还可以在excel对象模型的某些部分进行良好的练习/复习。

快乐的编码！

Public Sub ImportUpdates()
    Dim ImportXL As Workbook
    Dim OpenFiles() As Variant
    Dim pickUp as Variant
    Dim i As Long, n As Long, iXLRowC As Long, iXLColC As Long, cWbkRowC As LONG, cWbkColC As Long
    Dim Crntwrkbk As String
    Application.ScreenUpdating = False
    Crntwrkbk = ThisWorkbook.Name
    OpenFiles = Application.GetOpenFilename(Title:="Select File(s) To Import", MultiSelect:=True)
    n = Application.CountA(OpenFiles)
    For i = 1 To n
        Set ImportXL = Workbooks.Open(OpenFiles(i))
        With ImportXL
            iXLRowC = .WorkSheets("Entries").UsedRange.Rows.Count
            iXLColC = .WorkSheets("Entries").UsedRange.Columns.Count
            pickUp = .WorkSheets("Entries").Range(.WorkSheets("Entries").Cells(2,1), .WorkSheets("Entries").Cells(iXLRowC, iXLColC)).Value
        End with
        With Crntwrkbk
            cWbkRowC = .WorkSheets("Entries").UsedRange.Rows.Count
            cWbkColC = .WorkSheets("Entries").UsedRange.Columns.Count
            .Worksheets("Entries").Range(.Worksheets("Entries").Cells(cWbkRowC+1, .Worksheets("Entries").Cells(cWbkColC+1), _
                .WorkSheets("Entries").Cells(cWbkRowC+1+iXLRowC, cWbkColC+1+iXLColC))).Value2 = pickUp
        End with
        Erase pickUp
        ImportXL.Close True
    Next i
    Application.ScreenUpdating = True
End Sub

多个工作簿粘贴崩溃的3个以上文件

1 个答案: