Question

所以我在VBA中编写了一个相当简单的宏来更新一组变量，然后将更新后的值复制并粘贴到新工作表中。问题是卷现在变得有点压倒性，因此在Excel中达到1,048,576行限制，导致代码崩溃。

我想更新它，以便每当达到行限制时，脚本开始将单元格复制到新工作表（例如，＆＃34; FinalFile2＆＃34;，＆＃34; FinalFile3＆＃34;等等）直到它完全执行。

Sub KW()
'
' Exact KWs
'
Dim i, j, LastRow As Long
Dim relativePath As String

i = 2
j = 2

'LastRowValue'
Sheets("Output").Select
LastRow = Rows(Rows.Count).End(xlUp).Row - 1

'Clean final output'
  Sheets("FinalFile").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select

'Set Variables in Variables sheet'

Do

'Var 1'
    Sheets("Names").Select
    Range("A" & i).Select
    Selection.Copy
    Sheets("Variables").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Var 2'
    Sheets("Names").Select
    Range("B" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 'Var 3'
    Sheets("Names").Select
    Range("C" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 'Var 4'
    Sheets("Names").Select
    Range("D" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


 'Var 5'
    Sheets("Names").Select
    Range("E" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


  'Var 6'
    Sheets("Names").Select
    Range("F" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   'Var 7'
    Sheets("Names").Select
    Range("G" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    'Var 8'
    Sheets("Names").Select
    Range("H" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 9'
    Sheets("Names").Select
    Range("I" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 10'
    Sheets("Names").Select
    Range("J" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 11'
    Sheets("Names").Select
    Range("K" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy and Paste'

    Sheets("Output").Select
    Range("A2:AP2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("FinalFile").Select
    Range("A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'update counters'

i = i + 1
j = j + LastRow

'end of loop condition'

Sheets("Names").Select

Loop Until IsEmpty(Cells(i, 1))



End Sub

Answer 1

以下是一些如何改进代码的提示。我没有讨论我在原始问题的评论中提到的问题，而只关注代码的特定部分：

删除Selection。一般模式不是

something.Select
Selection.Dosomenthing

你使用

something.Dosomething

在你的情况下：

Sheets("Names").Select
Range("A" & i).Select
Selection.Copy
Sheets("Variables").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

变为

Sheets("Names").Range("A" & i).Copy
Sheets("Variables").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

使用变量来引用您的工作表：

Dim nameSheet as Worksheet
Dim varSheet as Worksheet
Dim finalSheet as Worksheet

Set nameSheet = Sheets("Names")
Set varSheet = Sheets("Variables")
Set finalSheet = Sheets("FinalFile")

现在你可以使用

finalSheet.Range(...).Pastespecial ...

并在空间不足时使用Set finalSheet = Sheets("FinalFile2")

不要一个接一个地复制彼此相邻的细胞。您正在将单元格Ai复制到A2，然后将Bi复制到B2。只需将范围Ai:Ki复制到A2:K2（虽然我不明白这一点）

如果您不需要，请不要使用Copy。而不是

someRange.Copy
someOtherRange.PasteSpecial Paste:=xlPasteValues

你可以使用

someOtherRange.Value = someRange.Value

（确保尺寸相同）

使用Screenupdating禁用Application.Screenupdating = False（在您完成后将其设为True）当您进行大量插入操作时。它可以加速宏。

关于你的实际问题，按照汤姆建议，添加

If j > 1048576 Then
    j = 2
    Set finalSheet = Sheets("FinalFile2") 'maybe create the new sheet at this point
End If

Answer 2

您可以添加

j = j + lastRow
If j = 1048576 Then j = 2

但你应该肯定清理这段代码。 .selections是一种非常缓慢的方式来做这样的事情。查看this并尝试避免.Copy＆amp; .Paste。只需使用=将目标单元格设置为源的值即可。这也节省了很多时间。

编辑：请务必查看@arcadeprecinct

发布的链接

Excel VBA复制范围为1,048,576行后的新工作表

2 个答案: