[已解决]条件填充行VBA异常

zengxiaojun

自动添加相同行内容，单元格数理如是8，就增加7行，总数增加到8行。完成后自动开始下个循环，空白行自动跳过。
以下代码报错：溢出，400，定义对象错误，请版主帮忙解决。非常感谢。

Sub fuzhi()                                                      '根据H列中的数量进行整列复制
   Dim ZHS As Integer                                            '定义变量ZHS（总行数），表格的总行数
   Dim SL As Integer                                             '定义变量SL（数量），H列中的数量
   Dim r As Integer
   Dim i As Integer
   Dim ii As Integer
   Range("A1").CurrentRegion.Select
   ZHS = Selection.Rows.Count                                     '获取表格总行数
   ZHS = ZHS - 1
   Range("H2").Select                                             '选择H2单元格，准备进行复制（如在其它列把“H”改成相应列数就行了）
   For i = 1 To ZHS
    If ActiveCell > 1 Then
         SL = ActiveCell
         SL = SL - 1
            For ii = 1 To SL
                ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Select
                Selection.Copy
                ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
                Selection.Insert Shift:=xlDown
            Next ii
            ActiveCell.Offset(1, 7).Select                       '以当前行为标准，选择下一行靠右的第七个单元格，及H列（数量）的单元格。（如“数量”不再H列则需将“Offset(1, 7)”里的“7”进行相应的修改）
        ElseIf ActiveCell = 1 Then
               ActiveCell.Offset(1, 0).Select
        End If
    Next i
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2015-5-22 16:46

网上查了一下"为了防止数据丢失,不能移去工作表中的非空白单元格..."这类提示的处理办法，是你源数据里面有些未知内容。加了行清除代码，可以正常运行。

跳转到最佳答案楼层

grf1973

搞得这么复杂干嘛，简洁版：

1. Sub fuzhi()                                                      '根据H列中的数量进行整列复制
   
2.    Dim ZHS&, i&, SL&
   
3.    ZHS = [H65536].End(3).Row - 1
   
4.    For i = ZHS To 1 Step -1
   
5.         SL = Val(Cells(i, "H")) - 1
   
6.         If SL > 0 Then Rows(i + 1).Resize(SL).Insert
   
7.    Next i
   
8. End Sub
   

复制代码

grf1973

上面代码只是根据H列数值插入行，如果要复制行，用此代码：

1. Sub fuzhi()                                                      '根据H列中的数量进行整列复制
   
2.    Dim ZHS&, i&, SL&
   
3.    ZHS = [H65536].End(3).Row - 1
   
4.    For i = ZHS To 1 Step -1
   
5.         SL = Val(Cells(i, "H")) - 1
   
6.         If SL > 0 Then
   
7.             Rows(i + 1).Resize(SL).Insert
   
8.             Rows(i + 1).Resize(SL) = Rows(i).Value
   
9.         End If
   
10.    Next i
    
11. End Sub
    

复制代码

zengxiaojun

grf1973 发表于 2015-5-22 16:13
搞得这么复杂干嘛，简洁版：

您好，你写的代码提示如下出问题： If SL > 0 Then Rows(i + 1).Resize(SL).Insert

grf1973

你用我的附件试试。如果你自己有附件，上传过来，具体情况要具体分析的。

zengxiaojun

grf1973 发表于 2015-5-22 16:17
上面代码只是根据H列数值插入行，如果要复制行，用此代码：

文件如附件，麻烦帮忙下，非常感谢。

grf1973

网上查了一下"为了防止数据丢失,不能移去工作表中的非空白单元格..."这类提示的处理办法，是你源数据里面有些未知内容。加了行清除代码，可以正常运行。

zengxiaojun

grf1973 发表于 2015-5-22 16:46
网上查了一下"为了防止数据丢失,不能移去工作表中的非空白单元格..."这类提示的处理办法，是你源数据里面有 ...

已经可以正常使用，非常感谢。

清除代码是把影响代码运行的内容清除掉吗？如果清除了就没有用了？