移动列时运行时错误' 7':内存不足

时间:2017-05-19 20:45:37

标签: excel vba excel-vba

提前感谢任何和所有帮助。我的宏应该做的是移动一些"键"列。我试图以最少的内存密集方式实现这一点。我做了以下工作,而不是切割柱子并插入它们。为什么我会遇到一个荒谬的内存不足错误呢?它甚至不是很多数据。 Excel现在大约有3.3GB的内存使用量。

有关清理我的代码的任何建议吗?

'Moves Critical Columns'
Sheets("A").Select
Application.CutCopyMode = False
Columns("H").Insert XlDirection.xlToRight
Columns("H").Value = Columns("X").Value
Columns("X").Delete

Sheets("B").Select
Application.CutCopyMode = False
Columns("H").Insert XlDirection.xlToRight
Columns("H").Value = Columns("X").Value
Columns("X").Delete

Sheets("C").Select
Application.CutCopyMode = False
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AA").Value
Columns("F").Value = Columns("Z").Value
Columns("Z").Delete
Columns("Z").Delete

Sheets("D").Select
Application.CutCopyMode = False
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AA").Value
Columns("F").Value = Columns("Z").Value
Columns("Z").Delete
Columns("Z").Delete

Sheets("E").Select
Application.CutCopyMode = False
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AG").Value
Columns("AG").Delete

Sheets("F").Select
Application.CutCopyMode = False
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AG").Value
Columns("AG").Delete

Sheets("G").Select
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AT").Value
Columns("F").Value = Columns("AU").Value
Columns("AU").Delete
Columns("AU").Delete

Sheets("H").Select
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("AT").Value
Columns("F").Value = Columns("AU").Value
Columns("AU").Delete
Columns("AU").Delete

Sheets("I").Select
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("T").Value
Columns("F").Value = Columns("BT").Value
Columns("G").Value = Columns("BU").Value
Columns("BU").Delete
Columns("BU").Delete
Columns("BU").Delete

Sheets("J").Select
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("T").Value
Columns("F").Value = Columns("BT").Value
Columns("G").Value = Columns("BU").Value
Columns("BU").Delete
Columns("BU").Delete
Columns("BU").Delete

Sheets("K").Select
Columns("E").Insert XlDirection.xlToRight
Columns("E").Insert XlDirection.xlToRight
Columns("E").Value = Columns("BS").Value
Columns("F").Value = Columns("BA").Value
Columns("BA").Delete
Columns("BA").Delete

3 个答案:

答案 0 :(得分:0)

DoEVENTS可能有所帮助 - 将它放在一个数组中并运行DoEvents会起作用或将它放在每一列之间。

简单来说,它允许操作系统在你的代码运行之间完成它的工作 - 我发现将它插入更长或更重的运行代码往往有助于消除内存错误。

https://msdn.microsoft.com/en-us/library/office/gg264522.aspx了解有关DoEvents的更多信息

答案 1 :(得分:0)

我不确定这是否会消除您所遇到的内存问题,因为我无法重现它,这可能是由于您环境中的某些原因造成的。但是,请尝试将您的工作限制为UsedRange,然后使用" Cut-Insert"技术而不是copy/insert/paste/delete

这是在下面的代码中的例程moveColumn中完成的操作。将常见任务分解并简化代码总是好的。请注意,moveColumn可用于同时移动多个邻居列;但不是如果他们的顺序会改变,在这种情况下你需要逐个移动它们(从将被移动到最左边位置的那个开始)。

最后,在代码执行过程中不需要Select任何东西,这也是一个麻烦的来源。考虑到这一切,您的代码可以写成如下:

Sub MoveCriticalColumns()
  moveColumn Sheets("A"), "X", "H"
  moveColumn Sheets("B"), "X", "H"

  moveColumn Sheets("C"), "AA", "E"
  moveColumn Sheets("C"), "Z", "F"

  moveColumn Sheets("D"), "AA", "E"
  moveColumn Sheets("D"), "Z", "F"

  moveColumn Sheets("E"), "AG", "E"
  moveColumn Sheets("F"), "AG", "E"

  moveColumn Sheets("G"), "AT:AU", "E:F" ' in one operation
  moveColumn Sheets("H"), "AT:AU", "E:F" ' in one operation

  moveColumn Sheets("I"), "T", "E"
  moveColumn Sheets("I"), "BT:BU", "F:G" ' in one operation

  moveColumn Sheets("J"), "T", "E"
  moveColumn Sheets("I"), "BT:BU", "F:G" ' in one operation

  moveColumn Sheets("K"), "BS", "E"
  moveColumn Sheets("K"), "BA", "F"
End Sub

Sub moveColumn(sh As Worksheet, oldPosition As String, newPosition As String)
  With sh.UsedRange
    .Columns(oldPosition).Cut
    .Columns(newPosition).Insert Shift:=xlToRight
  End With
End Sub

答案 2 :(得分:0)

剪切和插入,正如@ A.S.H提供的解决方案中所建议的那样。是非常有效的,因为它不复制格式。相反,它使用在目标位置找到的格式,从插入列的右侧或左侧。如果这是一个问题,意味着必须从源复制单元格格式,以下代码提供了另一种选择。

Sub MoveColumn(Ws As Worksheet, _
               Targets As String, _
               Sources As String)
    ' insert columns specified by "Targets"
    ' copy contents of "Sources" to the inserted columns
    ' and delete the "Sources" columns

    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim ClmCount As Integer

    With Ws.UsedRange
        Set SourceRange = .Columns(Sources)
        Set TargetRange = .Columns(Targets)
        ClmCount = TargetRange.Columns.Count
        If ClmCount < SourceRange.Columns.Count Then
            MsgBox "The number of columns specified as 'Source'" & vbCr & _
                   "exceeds the available space in the specified" & vbCr & _
                   "'Target' range.", vbCritical, "Invalid specification"
            Exit Sub
        End If
        .Columns(Targets).Insert Shift:=xlToRight
        Set TargetRange = .Cells(1, TargetRange.Column - ClmCount)
        SourceRange.Copy
        TargetRange.PasteSpecial
        Application.CutCopyMode = False

        SourceRange.Delete Shift:=xlToLeft
    End With
End Sub

此子句可以处理单个列或任意数量的相邻列。这是代码的示例,它将替换原始代码中的第一批列移动。请注意,使用ActiveSheet是危险的(您的原始代码会这样做),因为在查看代码时很容易忘记哪个工作表处于活动状态。

Private Sub TestMove()     Application.ScreenUpdating = False         MoveColumn ActiveSheet,“E:F”,“AT:AU”     Application.ScreenUpdating = True 结束子

第二批需要两次调用该过程,因为列不是连续的。将此批处理添加到调用过程后,它将如下所示: -

Private Sub TestMove()
    Application.ScreenUpdating = False
        MoveColumn ActiveSheet, "E:F", "AT:AU"
        MoveColumn Sheets("I"), "E:F", "BT:BU"
        MoveColumn Sheets("I"), "E", "T"
    Application.ScreenUpdating = True
End Sub