For循环在XY循环次数后停止正常工作

Question

我有这样的问题：

我的 VBA 宏中的一切运行顺利，直到 i = 3224。这意味着例如，如果 i=3000，则代码运行良好，但如果 i = 3224，它会停止工作。错误消息是运行时错误'1004'：范围类的填充方法失败我单击调试并尝试手动继续（F8）并且它有效。但是在接下来的i中，这种情况一次又一次地发生。我试图将代码更改为 Selection.Copy，但粘贴有相同类型的错误，因此如果 i>=3224（它应该至少运行到 5227），我似乎无法粘贴值。有人对此问题有一些解决方案吗？核心数据大约有 1200 行，如果我在 600 行上运行宏，它运行良好，但如果我复制这 600 行并制作 1200 行，它就会出现这个错误（所以问题不在核心数据中）。

这只是代码的一部分，在这部分我想用之前的非空白行填充每个空白行，直到工作表中的最后一行。

Dim LastRow As Long
Dim i As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = 3 To LastRow
Range("A" & i).Select
If IsEmpty(ActiveCell) = False Then
    i = i
Else: Rows(i & ":" & i).Select
    Selection.FillDown
EndIf
Next

Answer 1

填充行

Sub FillRows()
    
    Const HEADER_ROWS As Long = 2
    Const CRITERIA_COLUMN As Long = 1
    
    Dim rg As Range, rCount As Long, cCount As Long
    
    With ActiveSheet ' improve!
        With .UsedRange
            rCount = .Rows.Count - HEADER_ROWS
            cCount = .Columns.Count
            Set rg = .Resize(rCount).Offset(HEADER_ROWS)
        End With
    End With
    
    Dim Data(): Data = rg.Value
    Dim cr As Long: cr = 1
    
    Dim r As Long, c As Long, rStr As String
    
    For r = 2 To rCount
        rStr = CStr(Data(r, CRITERIA_COLUMN))
        If Len(rStr) = 0 Then
            For c = 1 To cCount
                Data(r, c) = Data(cr, c)
            Next c
        Else
            cr = r
        End If
    Next r
        
    rg.Value = Data
        
End Sub

Answer 2

尝试改变

Else: Rows(i & ":" & i).Select

到这个

Else
Range(Rows(i-1),Rows(i)).Select