时间戳

首页 > 解决方案 > ActiveSheet.Paste 的替代品以减少内存

excel - ActiveSheet.Paste 的替代品以减少内存

问题描述

我正在尝试在工作中利用 VBA/宏功能。但是，我遇到了一个类似“错误”的问题；内存不足'，在互联网上浏览了一番后，我意识到复制和粘贴通常会在 Excel 中占用大量空间，而我在工作场所的 Excel 只有 32 位。因此，有没有人知道 ActiveSheet.Paste 的任何好的替代品？

我的代码目前如下：

ActiveSheet.Range ("$A$!:$Y$1000").AutoFilter Field:=7, Criterial:=_banker
Range("A1").Select
Range(Selection, Selection.End(x1Down)).Select
Range(Selection, Selection.End(X1ToRight)).Select

Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste

ActiveSheet.Name= banker

i=i+1

Loop

End Sub

标签： excelvba

解决方案

  1. 您应该照原样复制您的代码，而不是编写它。这样，您将避免拼写错误（Range ("$A$!:$Y$1000")而不是"A1:...，X1ToRight而不是XlToRight，“_banker”而不是“银行家”）。按照上面的建议，放在Option Explicit模块顶部会有所帮助。

  2. 一种过滤和复制过滤范围的方法，不涉及剪贴板应该是下一个代码。请测试它并发送一些反馈：

Sub testFilterCopyRange()
  Dim sh As Worksheet, shNew As Worksheet, lastR As Long
  Dim banker As String, rng As Range, rngF As Range, arr, i As Long
  Dim maxIt As Long 'number of iterations
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
  maxIt = 1                 'set here the maximum number of necessary iterations
  sh.AutoFilterMode = False 'eliminate the previous filter
  
  Set rng = sh.Range("A1:H" & lastR) 'set the range to be processed
  For i = 1 To maxIt
     banker = "7" '"your dinamic criteria"
     rng.AutoFilter field:=7, Criteria1:=banker      'filter the range according to above defined criteria
     Set rngF = rng.SpecialCells(xlCellTypeVisible) 'set a range to keep the filtered cells in the range
    
     arr = arrayFromDiscRange(rngF, False) 'header inclusive
     Set shNew = Sheets.Add(After:=sh): shNew.Name = banker 'add a new sheet and name it
     shNew.Range("A1").Resize(UBound(arr), UBound(arr, 2)).value = arr 'drop the array content at once
 Next i
End Sub

'function able to transform a filtered (discontinue) range in an array:
Private Function arrayFromDiscRange(rngF As Range, Optional NoHeader As Boolean = False) As Variant
    Dim arr, i As Long, j As Long, k As Long, A As Range, R As Range, iRows As Long
    'count range rows
    For Each A In rngF.Areas
        iRows = iRows + A.rows.count
    Next A
    'Redim the array to keep the range
    ReDim arr(1 To iRows - IIf(NoHeader, 1, 0), 1 To rngF.Columns.count): k = 1
    
    For Each A In rngF.Areas 'iterate between the range areas:
        For Each R In A.rows  'iterate between the area rows:
            If NoHeader And k = 1 Then GoTo Later 'skip the first row, if no header wanted
                    For j = 1 To R.Columns.count 'iterate between the area row columns:
                        arr(k, j) = R.cells(1, j).value 'place each row cells value in the array row
                    Next j
                    k = k + 1   'intrement the array row to receive values
Later:
           Next
    Next A
    arrayFromDiscRange = arr 'returning the created array
End Function

如果有不清楚的地方，即使我尝试评论所有可能在理解上有问题的代码行，请不要犹豫，要求澄清。

推荐阅读