[已解决]删除空单元格

upper

要求在附件！
求助Book1.zip (3.92 KB, 下载次数: 9)

2013-5-28 10:08 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

1032446692

2013-5-28 10:27

Sub test()
    Dim a, i, k
    a = Cells(60000, 1).End(xlUp).Row
    arr = Cells(1, 1).Resize(a)
    For i = a To 1 Step -1
        If arr(i, 1) = "" Then
            k = k + 1
        Else
            If k <> 3 And k > 0 Then Cells(i + 1, 1).Resize(k).Delete Shift:=xlUp
            k = 0
        End If
    Next i
End Sub

跳转到最佳答案楼层

1032446692

Sub test()
    Dim a, i, k
    a = Cells(60000, 1).End(xlUp).Row
    arr = Cells(1, 1).Resize(a)
    For i = a To 1 Step -1
        If arr(i, 1) = "" Then
            k = k + 1
        Else
            If k <> 3 And k > 0 Then Cells(i + 1, 1).Resize(k).Delete Shift:=xlUp
            k = 0
        End If
    Next i
End Sub

xdd_sky

看看是否符合你的要求？