复制粘贴循环运行时错误6 [英] Copy Paste Loop Runtime Error 6

问题描述

我有下表：

Code     Year
8948KH   2003
         2004
         2005
         2006
923587   2003
         2004
         2005
         2006
938972   2003
         2004
         2005
         2006

假设代码在单元格A1中。我想要8948KH，923587和938972的值复制/粘贴自己，直到他们遇到另一个代码。

Assume "Code" is in cell A1. I want the values of 8948KH, 923587 and 938972 to copy/paste themselves until they run into another code.

为此，我使用了以下代码。我在D Mason创建的Stackoverflow中找到的：

To do this I used the following code. which I found on Stackoverflow made by D Mason:

Sub replaceBlanks()

' define variables
Dim column As Integer
Dim row As Integer
Dim lastRow As Integer
Dim previousValue As String
Dim value As String

' stop screen from updating to speed things up
Application.ScreenUpdating = False

' use the active sheet
With ActiveSheet

    ' get the current cell selected and the last row in column selected
    column = ActiveCell.column
    row = ActiveCell.row
    lastRow = .Cells(.Rows.Count, column).End(xlUp).row

    ' set previous value to the first cell
    previousValue = Cells(row, column).value

    ' iterate for every row between selected and last row with data in
    For i = row To lastRow
        ' set value = the content of that cell
        value = Cells(i, column).value
        ' if it contains nothing
        If Len(value) < 1 Then
            ' set the value of cell equal to the previous cell that had something in it
            Cells(i, column).value = previousValue
        ' if it contains something
        Else
            ' update the previous value and move on to next row
            previousValue = value
        End If

    Next i

End With

' update the screen at the end
Application.ScreenUpdating = True

End Sub

对于非常小的循环，这可以正常工作。但是，我需要循环大约6700个代码，扩展到80.000行。在每个代码和下一个代码之间，正好有11个空行，我需要他们留在那里将代码复制到。

This works fine for very small loops. However, I need to loop approximately 6700 pieces of code spread out over 80.000 rows. Between each code and the next there are exactly 11 blank rows and I need them to stay there to copy the codes into.

如果我尝试这样做，Excel会产生一个'运行时错误6溢出'，并且在调试器中引用 lastRow = .Cells（.Rows.Count，column）.End（xlUp）.row 。

If I try to do this, Excel yields a 'Runtime Error 6 Overflow' and refers to lastRow = .Cells(.Rows.Count, column).End(xlUp).row in the debugger.

有没有办法调整宏，以防止Excel生成错误？

Is there any way to adjust the macro in order to keep Excel from generating that error?

推荐答案

尝试这个tidier替代方案。

Try this tidier alternative.

Sub Fill_in_the_Blanks()
    With Cells(1, 1).CurrentRegion.Columns(1)
        .SpecialCells(xlCellTypeBlanks).Formula = "=A2"
        .Cells.Value = .Cells.Value
    End With
End Sub

这假定（从您的描述和示例数据）A2包含8948KH 并且单元格实际上是空白的，而不是由公式返回的零长度字符串。

This assumes (from your description and sample data) that A2 contains 8948KH and that the cells are actually blank and not zero length strings returned by formulas.

这篇关于复制粘贴循环运行时错误6的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！