删除行中空白单元格的宏

Question

我有一个宏可以删除每行中的空白单元格并将下一个单元格向左移动。该代码没有显示任何错误，但什么也没做。

由于行与行的列数可能不同，因此我在 For Each 循环中定义了最后一行。

帮忙指正，感激不尽。

Sub RemoveBlankCells()

Dim rng As Range
Dim row As Range
Dim cell As Range
Dim lastCol As Long
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("ABC")

For Each row In ws.Rows
    lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set rng = ws.Cells(1, lastCol)
  For Each cell In rng.Cells
    If cell.Value = "" Then
        cell.Delete Shift:=xlToLeft
    End If
  Next cell
Next row

End Sub

Answer 1

试试这个代码。它将其限制为仅填充的行 - 假设 A 列中始终包含某些内容。

Public Sub RemoveBlankCells()
    
    With ThisWorkbook.Worksheets("ABC")
    
        'Assume there's always something in column 1.
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).row
        
        'Set reference to column A of the range to work on.
        Dim SearchRange As Range
        Set SearchRange = .Range(.Cells(1, 1), .Cells(LastRow, 1))
        
        Dim rRow As Range
        For Each rRow In SearchRange.EntireRow
            
            'Find the last column number in the row.
            Dim LastColumn As Long
            LastColumn = .Cells(rRow.row, .Columns.Count).End(xlToLeft).Column
            
            'Work backwards deleting cells - if you delete a cell in column 3 and move to column 4...
            'column 4 has now become column 3 and that cell isn't checked.
            Dim Counter As Long
            For Counter = LastColumn To 1 Step -1
                If .Cells(rRow.row, Counter) = "" Then .Cells(rRow.row, Counter).Delete Shift:=xlToLeft
            Next Counter
        Next rRow
        
    End With

End Sub