使用VBA中的范围函数粘贴值

时间:2014-08-25 07:11:27

标签: excel excel-vba vba

我正在使用此代码粘贴范围的值,但每当我的数据有一百万或更多的行号时,我就开始面临问题,我想打破范围并在4/5部分中运行相同的代码(循环),有人可以帮我吗

Range("F14:J14").Select
Selection.Copy
With ActiveSheet
RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

Range("F14:J14").Select
Selection.Copy

Range("f15:J" & RowCount).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("f15:J" & RowCount).Select
Selection.Copy
Range("f15:J" & RowCount).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

1 个答案:

答案 0 :(得分:0)

你是对的,复制大量的单元格是有问题的,所以处理数据块是一个好主意。

尽管如此,依赖SelectCopy PasteSpecial也存在问题。

我会建议这个替代

Sub Demo()
    Dim rSrc As Range
    Dim rDst As Range
    Dim rBlk As Range
    Dim RowCount As Long
    Dim CopyRowStart As Long
    Dim CopyRowNum As Long

    ' Set number of rows to process at a time
    CopyRowNum = 100000

    ' Set references to source and Destination ranges
    With ActiveSheet
        Set rSrc = .Range("F14:J14")
        RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rDst = .Range("F15:J" & RowCount)
    End With

    ' Copy data in blocks
    CopyRowStart = 0
    Set rBlk = rDst.Resize(CopyRowNum)
    Do While CopyRowStart + CopyRowNum <= rDst.Rows.Count
        ' Copy formulas
        rBlk.Formula = rSrc.Formula
        ' Convert to values
        rBlk.Value = rBlk.Value
        ' Move to next block
        If rBlk.Row + CopyRowNum + CopyRowStart - 1 > rDst.Row + rDst.Rows.Count - 1 Then
            Exit Do
        End If
        Set rBlk = rBlk.Offset(CopyRowNum, 0)
        CopyRowStart = CopyRowStart + CopyRowNum
        DoEvents
    Loop
    ' Copy remaining rows
    If rBlk.Row + CopyRowNum <= rDst.Row + rDst.Rows.Count - 1 Then
        Set rBlk = rBlk.Resize(rDst.Row + rDst.Rows.Count - rBlk.Row - CopyRowNum)
        Set rBlk = rBlk.Offset(CopyRowNum, 0)
        rBlk.Formula = rSrc.Formula
        rBlk.Value = rBlk.Value
    End If
End Sub

请注意,相当复杂的范围大小计算旨在避免超出工作表的大小,当行数接近工作表的末尾时(1,048,576行)