Удаление пустой ячейки - PullRequest
0 голосов
/ 15 сентября 2018

В столбце А мы имеем числа от 1 до 10 соответственно И в столбце B мы держим буквы от a до j, которые не имеют порядка Мы удалили 4 письма Я не хочу менять столбец A, но столбец B удаляет ее пустые ячейки и буквы, следующие Следующий код удаляет строки с пустыми ячейками:

enter image description here

Sub DeleteEmptyRows()

'   Deletes the entire row within the selection if the ENTIRE row contains no data.

Dim i As Long
ActiveSheet.UsedRange.Select

With Application
    ' Turn off calculation and screenupdating to speed up the macro.
    .Calculation = xlCalculationManual
    .ScreenUpdating = False

    For i = Selection.Rows.Count To 2 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then Selection.Rows(i).EntireRow.Delete
    Next i

    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

Ответы [ 2 ]

0 голосов
/ 16 сентября 2018

Это решение будет циклически проходить через rangeAreas, копировать содержимое в столбце B этой области, удалять пробелы и, но результаты возвращаются в столбец b, мне требуется столбец Z в качестве вспомогательного столбца

Sub Button1_Click()
    Dim RangeArea As Range, x

    For Each RangeArea In Columns("A").SpecialCells(xlCellTypeConstants, 1).Areas
        x = RangeArea.Rows.Count
        RangeArea.Offset(, 1).Copy [z1]
        Columns("Z:Z").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        RangeArea.Offset(, 1).Value = Range("Z1:Z" & x).Value
        Range("Z:Z").Delete

    Next RangeArea

End Sub
0 голосов
/ 15 сентября 2018

Я не понимаю, как вы переходите от первого изображения ко второму, но если вы начнете со второго, это приведет вас к третьему.

Sub x()

On Error Resume Next 'avoid error if no blank cells
Columns("B").SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
On Error GoTo 0

End Sub
...