необходимо удалить пустые строки из таблицы Excel, а затем изменить размер таблицы - с помощью VBA - PullRequest
Новая
       34

необходимо удалить пустые строки из таблицы Excel, а затем изменить размер таблицы - с помощью VBA

0 голосов
/ 15 мая 2018

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

Моя проблема в том, что я не уверен, сколько из моего исходного диапазона данных (которые я копирую) будет действительно иметь значения (есть формула, которая либо дает ему значение, либо""), поэтому я беру большой диапазон, на всякий случай

Итак ... после того, как я вставил его, я хотел бы просмотреть таблицу и удалить все добавленные строки, которые имели только пустые строки ("") и никаких значений, а затем измените размер таблицы, чтобы она была такой же большой, как строки, содержащие данные.Эти строки могут быть в середине или в конце моих вставленных данных.Для этого мне нужна помощь по коду VBA.

Мне также может понадобиться очистить форматирование, которое таблица автоматически добавляет к этим дополнительным строкам, это код, который у меня есть до сих пор 

Range("O7:R30").Select    
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Ответы [ 2 ]

0 голосов
/ 15 мая 2018

Этот код работал, не элегантно, но он работал 

Sub copyToDeposits()

Dim theSheet As String
theSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Range("O7:R30").Select
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Dim lo As ListObject
Dim lRow As ListRow
Dim rng As Range
Dim delRows As Collection

Set lo = ActiveSheet.ListObjects("deposits") 'change to your table name
On Error Resume Next
For Each lRow In lo.ListRows
    Set rng = Nothing
    Set rng = lRow.Range.Cells(1, 2)
    If Not rng Is Nothing Then
        If rng = "" Then
            If delRows Is Nothing Then
                Set delRows = New Collection
                delRows.Add lRow
            Else
                delRows.Add lRow, Before:=1
            End If
        End If
    End If
Next
On Error GoTo 0

If Not delRows Is Nothing Then
    For Each lRow In delRows
        lRow.Delete
    Next
End If
Sheets(theSheet).Select
Application.ScreenUpdating = True

End Sub

0 голосов
/ 15 мая 2018

Вероятно, лучше всего помещать данные в таблицу только в том случае, если они действительны, а не очищать после вставки.

Примерно так 

Sub Demo()
    Dim rDest As Range
    Dim lo As ListObject
    Dim wsSrc As Worksheet
    Dim rSrc As Variant
    Dim i As Long
    Dim rng As Range

    'there are better ways to get a reference to the source data, but thats not the Q here
    Set wsSrc = ActiveSheet
    Set rSrc = wsSrc.Range("O7:R30")

    ' destination sheet
    With Sheets("deposits")
        'get reference to table
        Set lo = .ListObjects("deposits")

        'Get reference to first row after the table
        Set rDest = lo.DataBodyRange.Rows(lo.DataBodyRange.Rows.Count + 1)

        i = 0
        'loop thru source data rows
        For Each rng In rSrc.Rows
            'if a row has data
            If Application.WorksheetFunction.CountA(rng) > 0 Then
                'copy values into table
                rDest.Offset(i).Value = rng.Value
                i = i + 1
            End If
        Next
    End With
End Sub
...