[已解决]删除空单元格并上移

1小小草

删除空单元格并上移 求助代码

最佳答案

月排行榜 / 总排行榜

sam-wang

2022-5-27 15:10

1小小草 发表于 2022-5-27 14:43
咋不行呢？

請測試看看，謝謝

Sub test()
Dim xD, xR As Range, xU As Range
Application.ScreenUpdating = False
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range(Cells(Rows.Count, 1).End(3), [a1])
    If xR <> "" Then GoTo 99
    If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
99: Next
If Not xU Is Nothing Then xU.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

心正意诚身修

CTRL+G定位空值。右键 。。删除，选择上移，就可以了。

1小小草

想要代码的

1小小草

sam-wang

1小小草 发表于 2022-5-27 10:21

可以附上檔案，避免解讀有誤，謝謝

caobao02

'
Dim endrow As Single

Dim K As Single


endrow = Range("a65535").End(xlUp).Row



    For K = 2 To endrow
   

    If Cells(K, 2).Value = "0" And Cells(K, 3).Value = "0" And Cells(K, 5).Value = "0" And Cells(K, 6).Value = "0" Then             '如果单元格为空白


    Rows(K).Delete

K = K - 1


    End If


    Next K

1小小草

咋不行呢？

sam-wang

1小小草 发表于 2022-5-27 14:43
咋不行呢？

請測試看看，謝謝

Sub test()
Dim xD, xR As Range, xU As Range
Application.ScreenUpdating = False
Set xD = CreateObject("Scripting.Dictionary")
For Each xR In Range(Cells(Rows.Count, 1).End(3), [a1])
    If xR <> "" Then GoTo 99
    If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
99: Next
If Not xU Is Nothing Then xU.EntireRow.Delete
Application.ScreenUpdating = True
End Sub

风林火山

Range("A1:A20").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

1小小草

謝謝