Блог

Главная - Вопросы по программированию - Удаление предыдущих пустых столбцов и строк

Удаление предыдущих пустых столбцов и строк

#excel #vba

#excel #vba

Вопрос:

Я пытаюсь написать код VBA для циклического просмотра каждого листа в активной книге и удаления всех пустых столбцов и строк, ведущих к первой ячейке с данными. Например, если первая ячейка с данными равна D5, столбцы A-C и строки 1-4 будут удалены, оставляя данные, начинающиеся с A1. У меня есть приведенный ниже код, который работает для активного листа, но я не могу понять, как заставить его перебирать другие листы.

 
Sub DeleteRowsColumns()
' This will delete all Blank Columns and Rows before any data
    Dim ColCounter As Long
    Dim RowCounter As Long
    Dim SafeCount As Integer
    Dim ws As Worksheet
    SafeCount = 0
' Check Column A is empty if Yes then Delete till A is populated
    
For Each ws In ActiveWorkbook.Worksheets
    
    Do While ColCounter = 0
        SafeCount = SafeCount   1
        ColCounter = Application.CountA(Columns(1).EntireColumn)
        If ColCounter = 0 Then
            Columns(1).EntireColumn.Delete
        End If
        If SafeCount = 50 Then
            Exit Do
        End If
    Loop

Next ws

' Check Row 1 is empty if Yes then Delete till 1 is populated

For Each ws In ActiveWorkbook.Worksheets
    
    SafeCount = 0
    Do While RowCounter = 0
        SafeCount = SafeCount   1
        RowCounter = Application.CountA(Rows(1).EntireRow)
        If RowCounter = 0 Then
            Rows(1).EntireRow.Delete
        End If
        If SafeCount = 50 Then
            Exit Do
        End If
    'Loop

Next ws

MsgBox "Removed Preceding Blank Rows and Columns"

End Sub

Ответ №1:

В каждом цикле вам нужно указать, на каком листе вы выполняете операции. Простое перебирание не решает проблему. Например:

     ColCounter = Application.CountA(ws.Columns(1).EntireColumn)
    If ColCounter = 0 Then
        ws.Columns(1).EntireColumn.Delete

Это гарантирует, что вы работаете на правильном листе.

Добавьте его в цикл.

 For X = 1 To 50
    For i = 1 To 50
    ColCounter = Application.CountA(ws.Columns(i).EntireColumn)
        If ColCounter = 0 Then
            ws.Columns(i).EntireColumn.Delete
        End If
        rowCounter = Application.CountA(ws.Rows(i).EntireRow)
        If rowCounter = 0 Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next i
Next X

Ответ №2:

Вы могли бы избежать любого цикла, сначала найдя, где начинается содержимое (по строке, а затем по столбцу)

 Sub RemoveEmpties()
    Dim f As Range, f2 As Range, ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        'first occupied cell on sheet (by row)
        Set f = ws.Cells.Find(What:="*", After:=ws.Cells(ws.Rows.Count, ws.Columns.Count), _
                    LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False)
        
        If Not f Is Nothing Then
            'have content, so find first-occupied column
            Set f2 = ws.Cells.Find(What:="*", After:=ws.Cells(ws.Rows.Count, ws.Columns.Count), _
                           LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
                           SearchDirection:=xlNext, MatchCase:=False)

            'remove rows/columns as required
            If f.Row > 1 Then ws.Cells(1, 1).Resize(f.Row - 1).EntireRow.Delete
            If f2.Column > 1 Then ws.Cells(1, 1).Resize(, f2.Column - 1).EntireColumn.Delete
        End If
    Next ws
End Sub

В качестве альтернативы (опять же, максимум два удаления):

 Sub RemoveEmpties2()
    Dim ws As Worksheet, r As Long, c As Long
    For Each ws In ActiveWorkbook.Worksheets
        'first make sure there's some content on the sheet...
        If Application.CountA(ws.Cells) > 0 Then
            r = 1: c = 1
            Do While Application.CountA(ws.Rows(r)) = 0
                r = r   1
            Loop
            If r > 1 Then ws.Rows(1).Resize(r - 1).Delete
            Do While Application.CountA(ws.Columns(c)) = 0
                c = c   1
            Loop
            If c > 1 Then ws.Columns(1).Resize(, c - 1).Delete
        End If
    Next ws
End Sub

Ответ №3:

Используя Find метод

Поток

  • В процедуре delFirstBlank определяется рабочая книга. Объявлена переменная рабочего листа. В следующем For Each Next цикле для каждого листа в рабочей книге вызывается процедура deleteFirstBlank . При завершении цикла в окне сообщения пользователю сообщается, что код завершен.
  • В deleteFirstBlank процедуре результат функции getFirstRow записывается в переменную. Затем переменная проверяется, равна ли она 0 , т. е. Рабочий лист пуст. Если это так, то процедура завершается. Если нет, переменная проверяется, если она больше 1 , т. Е. Если хотя бы первая строка пуста. Если это так, то удаляются строки от первой строки до строки, определяемой переменной, уменьшенной на единицу. Затем результат функции getFirstRow записывается в переменную, которая проверяется, если она больше 1 , т. Е. Если по крайней мере первый столбец пуст. Если это так, то столбцы от первого столбца до столбца, определенного переменной, уменьшенной на единицу, удаляются.
  • В getFirstRow процедуре (функции) объявляется переменная диапазона. Используя Find метод поиска по строкам, первая найденная непустая ячейка (диапазон) на предоставленном листе присваивается переменной range. Если результатом Find метода был диапазон ячеек, его строка записывается как результат функции. Если нет, 0 записывается как результат, т. Е. рабочий лист остается пустым.
  • В getFirstColumn процедуре (функции) объявляется переменная диапазона. Используя Find метод поиска по столбцам, первая найденная непустая ячейка (диапазон) на предоставленном листе присваивается переменной range. Если результатом Find метода был диапазон ячеек, его столбец записывается как результат функции. Если нет, 0 записывается как результат, т. Е. рабочий лист пуст (последнее никогда не произойдет, потому что рабочий лист уже был протестирован, если он пуст в процедуре ‘getFirstRow’).

Код

 Option Explicit

Sub delFirstBlank()
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        deleteFirstBlank ws
    Next ws
    MsgBox "Removed first blank rows and columns.", vbInformation, "Success"
End Sub

Sub deleteFirstBlank(Sheet As Worksheet)
    Dim Current As Long
    Current = getFirstRow(Sheet)
    If Current = 0 Then GoTo ProcExit ' Blank sheet.
    If Current > 1 Then
        Sheet.Range(Sheet.Rows(1), Sheet.Rows(CLng(Current) - 1)).Delete
    End If
    Current = getFirstColumn(Sheet)
    If Current > 1 Then
        Sheet.Range(Sheet.Columns(1), Sheet.Columns(CLng(Current) - 1)).Delete
    End If
ProcExit:
End Sub

Function getFirstRow(Sheet As Worksheet) As Long
    Dim rng As Range
    Set rng = Sheet.Cells.Find(What:="*", _
                               After:=Sheet.Cells(Sheet.Rows.Count, _
                                                  Sheet.Columns.Count), _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByRows)
    If Not rng Is Nothing Then
        getFirstRow = rng.Row
    Else
        getFirstRow = 0 ' Blank Sheet
    End If
End Function

Function getFirstColumn(Sheet As Worksheet) As Long
    Dim rng As Range
    Set rng = Sheet.Cells.Find(What:="*", _
                               After:=Sheet.Cells(Sheet.Rows.Count, _
                                                  Sheet.Columns.Count), _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByColumns)
    If Not rng Is Nothing Then
        getFirstColumn = rng.Column
    Else
        getFirstColumn = 0 ' Blank Sheet
    End If
End Function