[已解决]删除相同位置数据（需修改）

乐乐2006201506

请修改并简化下面程序，使之可以实现批量删除。具体在附件中，批量删除无限个相同表格，相同位置的数据。同时要把红底框中的数据也要删除。

Sub 删除数据()
'
' 删除数据 Macro
'

'
    Range( _
        "B5:E5,G5:H5,K5:M5,D6:H6,L6:M6,C7:E7,J7:M7,F8:H8,L8:M8,K9,F10:K10,M10,B13:M15") _
        .Select
    Range("B13").Activate
    ActiveWindow.SmallScroll Down:=6
    Range( _
        "B5:E5,G5:H5,K5:M5,D6:H6,L6:M6,C7:E7,J7:M7,F8:H8,L8:M8,K9,F10:K10,M10,B13:M15,F16:G16,J16,M16" _
        ).Select
    Range("M16").Activate
    ActiveWindow.SmallScroll Down:=6
    Range( _
        "B5:E5,G5:H5,K5:M5,D6:H6,L6:M6,C7:E7,J7:M7,F8:H8,L8:M8,K9,F10:K10,M10,B13:M15,F16:G16,J16,M16,A18:G18,A19:G19" _
        ).Select
    Range("A19").Activate
    ActiveWindow.SmallScroll Down:=6
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-30
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2016-4-6 18:29

Sub 删除数据()
    Range("B5,G5,K5,D6,L6,C7,J7,F8,L8,K9,F9,F10,M9:M10,B13:M15,F16,J16,M16,A18:G19,A19") = ""
    With Range("A20:A" & Range("A65536").End(3).Row)
        Set c = .Find("姓  名")
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Range("A5:M19").Copy c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

跳转到最佳答案楼层

乐乐2006201506

重新做也可以。

爱疯

建议直接表达需求

zjdh

Sub 删除数据()
    Range("B5,G5,K5,D6,L6,C7,J7,F8,L8,K9,F9,F10,M9:M10,B13:M15,F16,J16,M16,A18:G19,A19") = ""
    With Range("A20:A" & Range("A65536").End(3).Row)
        Set c = .Find("姓  名")
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Range("A5:M19").Copy c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

zjdh

Book2.rar (19.04 KB, 下载次数: 12)

2016-4-6 18:34 上传

点击文件名下载附件

乐乐2006201506

zjdh  能解释一下语句吗？不胜感激。
Sub 删除数据()
    Range("B5,G5,K5,D6,L6,C7,J7,F8,L8,K9,F9,F10,M9:M10,B13:M15,F16,J16,M16,A18:G19,A19") = ""
    With Range("A20:A" & Range("A65536").End(3).Row)
        Set c = .Find("姓  名")
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Range("A5:M19").Copy c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub

zjdh

Sub 删除数据()
    Range("B5,G5,K5,D6,L6,C7,J7,F8,L8,K9,F9,F10,M9:M10,B13:M15,F16,J16,M16,A18:G19,A19") = "" 清除内容
    With Range("A20:A" & Range("A65536").End(3).Row)    搜索范围A20至A列有数据的最后一行
        Set c = .Find("姓  名")           查找“姓名”所在单元
        If Not c Is Nothing Then          若找到
            firstAddress = c.Address      记录首地址，以防死循环
            Do
                Range("A5:M19").Copy c    用已清除内容的表格复制覆盖
                Set c = .FindNext(c)      查找下一个
            Loop While Not c Is Nothing And c.Address <> firstAddress   跳转直至找不到或不是首地址
        End If
    End With
End Sub

乐乐2006201506

谢谢！