excel VBA为什么追加表格后出现空行?

axr492tv  于 2023-02-20  发布在  其他
关注(0)|答案(4)|浏览(200)

我是VBA新手。
实际上,我是在收集每周的合规性记录。我的主要问题是,我有一个动态的查询表,在一个好的星期它是空的。我希望能够提取此表的内容,并将它们粘贴到包含年初至今数据的静态表下面的第一个空行。
这一步很容易手动完成,但我希望实现自动化,以便将这份报告交给不太懂技术的团队成员。
这个问题:How to copy and paste two separate tables to the end of another table in VBA?已经提供了我目前使用的大部分内容,我交换了其中的一些值和声明,以与我的工作表和范围相关,但大部分内容都是复制/粘贴"Destination:="
在大多数情况下,这个块做的正是我所追求的:
(我已经注解了GCC的第二个范围,但打算在这个范围解决后使用它。)

Sub Inv_Copy_Paste()
    Dim TC As Worksheet
    'Dim Chart As Worksheet
    Dim lr2 As Long

    Set TC = Worksheets("TC Data Dump")
    'Set Chart = Worksheets("Inventory for Charts")
    lr2 = TC.Cells(Rows.Count, 1).End(xlUp).Row

    With TC
        .Range("O2", ("W2" & .Range("O" & Rows.Count).End(xlUp).Row)).Copy Destination:=TC.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        '.Range("K2", ("S2" & .Range("K" & Rows.Count).End(xlUp).Row)).Copy Destination:=Chart.Range("A" & lr2 + 1)
    End With
End Sub

我遇到的一个例外是,一旦代码复制了填充的数据,它就会在数据下面添加一些空行:
20 Blank Rows
这是我在这里已经存在的代码中忽略的东西吗?我承认我几乎不理解代码在使用TC部分中的作用,因此任何额外的上下文都将非常感谢。

    • 附加问题**:当我试图将 * 另一个 * 动态查询表复制到第二个静态表时,我是否需要一个单独的Sub/Worksheet?
kx5bkwkv

kx5bkwkv1#

处理空白

  • 如果数据在Excel表中,则应使用它们的方法和属性。
  • 如果你不想,你就需要编写特殊的,通常是复杂的代码。
  • End(xlUp)只会向上到表格的最后一行(单元格),如果底部有空行或空白行,也会被复制。
  • 使用xlFormulasFind方法将转到最后一个非空行,而使用xlValuesFind方法将(进一步)转到最后一个非空行。
    • 姓名首字母**

第一节第一节第一节第一节第一次

    • 结果**

    • 主要**
Sub InvCopyPaste()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim wsTC As Worksheet: Set wsTC = wb.Sheets("TC Data Dump")
    Dim wsInv As Worksheet: Set wsInv = wb.Sheets("Inventory for Charts")
    
    Dim srg As Range, drg As Range
    
    ' Source: 'wsTC' to Destination: 'wsTC'
    Set srg = RefNonBlankRange(wsTC.Range("O2:W2"))
    If Not srg Is Nothing Then
        Set drg = RefFirstNonBlankRowRange(wsTC.Range("A2") _
            .Resize(, srg.Columns.Count)).Resize(srg.Rows.Count)
        drg.Value = srg.Value ' for only values (most efficient)
        'srg.Copy drg ' instead: for values, formulas and formats
        Debug.Print "Copied from " & srg.Address & " to " & drg.Address & "."
    End If
    
    ' Source: 'wsTC' to Destination: 'wsInv'
    Set srg = RefNonBlankRange(wsTC.Range("K2:S2"))
    If Not srg Is Nothing Then
        Set drg = RefFirstNonBlankRowRange(wsInv.Range("A2") _
            .Resize(, srg.Columns.Count)).Resize(srg.Rows.Count)
        drg.Value = srg.Value ' for only values (most efficient)
        'srg.Copy drg ' instead: for values, formulas and formats
        Debug.Print "Copied from " & srg.Address & " to " & drg.Address & "."
    End If
    
End Sub
    • 帮助**
Function RefNonBlankRange( _
    ByVal FirstRowRange As Range) _
As Range
    With FirstRowRange
        Dim cel As Range: Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlValues, , xlByRows, xlPrevious)
        If Not cel Is Nothing _
                Then Set RefNonBlankRange = .Resize(cel.Row - .Row + 1)
    End With
End Function

Function RefFirstNonBlankRowRange( _
    ByVal FirstRowRange As Range) _
As Range
    Dim rg As Range: Set rg = FirstRowRange.Rows(1)
    With rg
        Dim cel As Range: Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlValues, , xlByRows, xlPrevious)
        If Not cel Is Nothing Then Set rg = .Offset(cel.Row - .Row + 1)
    End With
    Set RefFirstNonBlankRowRange = rg
End Function
    • Debug.Print * 即时窗口中的结果 Ctrl+G*
Copied from $O$2:$W$6 to $A$4:$I$8.
Copied from $K$2:$S$6 to $A$6:$I$10.
3b6akqbq

3b6akqbq2#

首先,行计数是计算第一列的行数。-lr 2 = TC.Cells(Rows.Count,1).End(xlUp).Row Here。而不是计算你要复制的表格中的行数。如果你把这一行中的数字1改为你要复制的列,我想它是“O”,也就是15。
那么恐怕您必须为第二个表重新定义lr 2或为其创建另一个变量。lr 3 = TC.Cells(Rows.Count,11).End(xlUp).Row '11表示第k列
如果有帮助请告诉我。

8i9zcol2

8i9zcol23#

Sub oddzac()

Dim RowCount As Integer

ActiveSheet.Range("O2", Cells(Range("W" & Rows.Count).End(xlUp).Row, "W")).Copy Cells(Range("A" & Rows.Count).End(xlUp).Row, 1)
ActiveSheet.Range("K2", Cells(Range("S" & Rows.Count).End(xlUp).Row, "S")).Copy Cells(Range("A" & Rows.Count).End(xlUp).Row + 1, 1)

End Sub

这就是你要找的吗

bq9c1y66

bq9c1y664#

另一个论坛回应了这个解决方案:

Sub TC_Copy_Paste()
Dim TC As Worksheet, RowNum As Long
'
Set TC = Worksheets("TC Data Dump")

On Error Resume Next

With TC.Range("P3").ListObject
    RowNum = Application.WorksheetFunction.CountA(.ListColumns(1).DataBodyRange)
    .DataBodyRange.Cells(1, 1).Resize(RowNum, 9).Copy Destination:=TC.Cells(Rows.Count, 5).End(xlUp).Offset(1)
End With

With TC.Range("AJ3").ListObject
    RowNum = Application.WorksheetFunction.CountA(.ListColumns(1).DataBodyRange)
    .DataBodyRange.Cells(1, 1).Resize(RowNum, 9).Copy Destination:=TC.Cells(Rows.Count, 26).End(xlUp).Offset(1)
End With
End Sub

同样,我不知道为什么这个工作和其他不,但我想分享最终的结果。

相关问题