关于指定条件删除行报错1004

hujianjian123

红色是我录制的一段“判断条件删除行”的宏，  当满足条件时是可以执行宏，  但是没有满足条件的时候执行宏会报错1004

麻烦老师们帮忙改下代码，让他不要报错   谢谢了



Sub test()


mt = Timer
   
    ActiveWindow.SmallScroll Down:=24
    Range("P46:P104").Select
    ActiveWindow.SmallScroll Down:=-69
    Selection.SpecialCells(xlCellTypeConstants, 2).Select
    Selection.EntireRow.Delete
    ActiveWindow.SmallScroll Down:=-18

   Range("D2:I2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D8:J8").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D10:J10").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D4:J10").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        Range("D10").Select
    Selection.NumberFormatLocal = "G/í¨óøñê½"
        Range("F16").Select
    End With


MsgBox "耗时:" & Format(Timer - mt, "0.000秒")
Range("F10").Select
End Sub

hujianjian123

自己顶一下   别沉了

蓝桥玄霜

没有附件不能测试代码。
建议上传Excel表格附件来说明问题。
没有表格附件的求助帖很少能获得满意的回复。
录制宏获得的代码都需要修改优化的。

hujianjian123

蓝桥玄霜 发表于 2020-3-9 07:45
没有附件不能测试代码。
建议上传Excel表格附件来说明问题。
没有表格附件的求助帖很少能获得满意的回复 ...

请老师帮忙优化代码   谢谢

蓝桥玄霜

1. Sub jj()
   
2. '
   
3. ' jj 宏
   
4. '
   
5. 
   
6.     On Error Resume Next
   
7.     Range("A4:A18").Select
   
8.     Selection.SpecialCells(xlCellTypeConstants, 2).Delete
   
9.     Range("A1") = "统计"
   
10.     Range("A2") = "=SUM(R[2]C:R[22]C)"
    
11.     Range("A3").Select
    
12. End Sub
    

复制代码