0

我写了一个宏（主要是通过记录它），它从一张纸上的一个部分复制数据，然后在另一张纸上计算我的表格的结尾并粘贴（粘贴特殊，因为我粘贴的数据是一个公式，我需要粘贴值）数据到我的表的末尾，这本身就增加了我的表的大小。这样可行。

我的问题是我不确定我的原始数据范围（我正在复制）中有多少实际上会有值（有一个公式给它一个值或“”），所以我取了一个大范围，以防万一

所以....在我粘贴它之后，我想通过我的表格并删除所有添加的只有空字符串（“”）并且没有值的行，然后调整表格的大小，使其仅与有数据的行。这些行可以在我粘贴的数据的中间或末尾。我需要有关 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
4

2 回答 2

1

如果数据有效，最好只将数据放入表中，而不是在粘贴后清理。

像这样的东西

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
于 2018-05-15T06:19:14.157 回答
1

这段代码有效，不优雅，但有效

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

结束子

于 2018-05-15T20:49:06.357 回答