如何 select table 列中最后填充的单元格
How to select last populated cell in table column
我正在学习如何使用 macros/vba 并使用记录宏功能来了解其工作原理。对于“Range("A31").Activate”部分,如何使其 select 成为最后一个填充的单元格?由于此列每天都在变化 - 我想将代码从这个 table 复制到另一个
Sub PurshToOutput()
Range("Inputtable[[#Headers],[UPC]]").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("Inputtable[UPC]").Select
Range("A31").Activate
Selection.Copy
Sheets("OUTPUT").Select
Range("Outputtable[UPC]").Select
ActiveSheet.Paste
End Sub
选择、激活只会消耗Excel资源,不会带来任何好处。录制宏时,Excel显示选择只是因为它们已经完成并且已经录制,而不是因为它们是必要的。获取特定 ListObject
中特定列的最后一个单元格可以通过以下方式完成:
Sub lastCellInTableColumn()
Dim lastCellUPC As Range
Set lastCellUPC = Range("Outputtable[UPC]").cells(Range("Outputtable[UPC]").Rows.count, 1)
Debug.Print lastCellUPC.Address, lastCellUPC.Value
End Sub
如果您只想复制最后一个单元格(UPC 列)的值,在第二个 table 的所有 UPC 列中,您可以简单地使用:
Range("Inputtable[UPC]").cells(Range("Inputtable[UPC]").Rows.count, 1).Copy _
Sheets("OUTPUT").Range("Outputtable[UPC]")
已编辑:
要复制所有栏目内容,您可以使用以下方法。由于 table 名称应该是唯一的,因此不必在它们所在的位置使用 sheet 名称:
Range("Inputtable[UPC]").Copy Range("Outputtable[UPC]").cells(1) 'copy all column
更好的方法(更快且需要更少的资源)是使用数组,因为 tables 中的格式非常相似。剪贴板将不再涉及。上面的复制方式可以用这种更高效的方式代替:
Dim arr: arr = Range("Inputtable[UPC]").Value
Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr
现在,如果列未满而您只需要复制现有范围,您可以使用下一种方式:
Dim lastC As Range, arr
Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))
If Not lastC Is Nothing Then
arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
If IsArray(arr) Then
Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr
Else
Range("Outputtable[UPC]").cells(1).Value = arr
End If
End If
Function lastUsedTblCell(tblRng As Range) As Range
Dim lastC As Range
Set lastC = tblRng.Find(what:="*", After:=tblRng.cells(1), LookIn:=xlValues, searchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not lastC Is Nothing Then
Set lastUsedTblCell = lastC
End If
End Function
如果您want/need以与第二个 table 列相关的类似方式进行,意思是将 粘贴到其第一个空行 ,您可以使用以下方式(也使用上面的函数):
Dim lastC As Range, arr
Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))
Dim lastCOut As Range
Set lastCOut = lastUsedTblCell(Range("Outputtable[UPC]"))
If lastCOut Is Nothing Then Set lastCOut = Range("Outputtable[UPC]").cells(1).Offset(-1)
If Not lastC Is Nothing Then
arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
If IsArray(arr) Then
lastCOut.Offset(1).resize(UBound(arr), 1).Value = arr
Else
lastCOut.Offset(1).Value = arr
End If
End If
End Sub
在最后一种情况下,如果粘贴的行数大于 table 行,table 将扩展为必要的行.
如果有什么不清楚的,请不要犹豫,要求澄清。
我认为您的代码的问题在于它带来了不必要的复杂性。
您所要做的就是 select 您需要最后一个单元格值的列 header。转到最后一个单元格,将其复制并粘贴到所需位置。
您可以尝试复制最后一个单元格值:
Range("inputtable[[#Headers],[UPC]]").Select
Selection.End(xlDown).Select
Selection.Copy
复制ExcelTable列(ListColumn
)
- 这会将数据从一个 table 的列附加到另一个 table 的列。希望后者 table 的其余列有公式,这些公式会得到更新,以使其有意义。
- Input 部分的前 4 行说明如何分层引用各种对象,而最后 4 行说明如何引用最后一个 non-blank 单元格(
ilCell
) 和从第一列单元格到最后一个 non-blank 单元格的范围 (irg
)。
Option Explicit
Sub PurshToOutput()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Input
Dim iws As Worksheet: Set iws = wb.Worksheets("INPUT")
Dim itbl As ListObject: Set itbl = iws.ListObjects("Inputtable")
Dim ilcl As ListColumn: Set ilcl = itbl.ListColumns("UPC")
Dim irg As Range: Set irg = ilcl.DataBodyRange
' The Last Non-Blank Cell
Dim ilCell As Range: Set ilCell = irg.Find("*", , xlValues, , , xlPrevious)
If ilCell Is Nothing Then Exit Sub ' no data in column
Dim irCount As Long: irCount = ilCell.Row - irg.Row + 1
' The Range From the First Cell to the Last Cell
Set irg = irg.Resize(irCount)
' Output
Dim ows As Worksheet: Set ows = wb.Worksheets("OUTPUT")
Dim otbl As ListObject: Set otbl = ows.ListObjects("Outputtable")
Dim olcl As ListColumn: Set olcl = otbl.ListColumns("UPC")
Dim ofcell As Range
With olcl.DataBodyRange
Set ofcell = .Cells(.Cells.Count).Offset(1)
End With
Dim org As Range: Set org = ofcell.Resize(irg.Rows.Count)
' Copy by Assignment
org.Value = irg.Value
End Sub
我正在学习如何使用 macros/vba 并使用记录宏功能来了解其工作原理。对于“Range("A31").Activate”部分,如何使其 select 成为最后一个填充的单元格?由于此列每天都在变化 - 我想将代码从这个 table 复制到另一个
Sub PurshToOutput()
Range("Inputtable[[#Headers],[UPC]]").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("Inputtable[UPC]").Select
Range("A31").Activate
Selection.Copy
Sheets("OUTPUT").Select
Range("Outputtable[UPC]").Select
ActiveSheet.Paste
End Sub
选择、激活只会消耗Excel资源,不会带来任何好处。录制宏时,Excel显示选择只是因为它们已经完成并且已经录制,而不是因为它们是必要的。获取特定 ListObject
中特定列的最后一个单元格可以通过以下方式完成:
Sub lastCellInTableColumn()
Dim lastCellUPC As Range
Set lastCellUPC = Range("Outputtable[UPC]").cells(Range("Outputtable[UPC]").Rows.count, 1)
Debug.Print lastCellUPC.Address, lastCellUPC.Value
End Sub
如果您只想复制最后一个单元格(UPC 列)的值,在第二个 table 的所有 UPC 列中,您可以简单地使用:
Range("Inputtable[UPC]").cells(Range("Inputtable[UPC]").Rows.count, 1).Copy _
Sheets("OUTPUT").Range("Outputtable[UPC]")
已编辑:
要复制所有栏目内容,您可以使用以下方法。由于 table 名称应该是唯一的,因此不必在它们所在的位置使用 sheet 名称:
Range("Inputtable[UPC]").Copy Range("Outputtable[UPC]").cells(1) 'copy all column
更好的方法(更快且需要更少的资源)是使用数组,因为 tables 中的格式非常相似。剪贴板将不再涉及。上面的复制方式可以用这种更高效的方式代替:
Dim arr: arr = Range("Inputtable[UPC]").Value
Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr
现在,如果列未满而您只需要复制现有范围,您可以使用下一种方式:
Dim lastC As Range, arr
Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))
If Not lastC Is Nothing Then
arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
If IsArray(arr) Then
Range("Outputtable[UPC]").cells(1).resize(UBound(arr), 1).Value = arr
Else
Range("Outputtable[UPC]").cells(1).Value = arr
End If
End If
Function lastUsedTblCell(tblRng As Range) As Range
Dim lastC As Range
Set lastC = tblRng.Find(what:="*", After:=tblRng.cells(1), LookIn:=xlValues, searchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not lastC Is Nothing Then
Set lastUsedTblCell = lastC
End If
End Function
如果您want/need以与第二个 table 列相关的类似方式进行,意思是将 粘贴到其第一个空行 ,您可以使用以下方式(也使用上面的函数):
Dim lastC As Range, arr
Set lastC = lastUsedTblCell(Range("Inputtable[UPC]"))
Dim lastCOut As Range
Set lastCOut = lastUsedTblCell(Range("Outputtable[UPC]"))
If lastCOut Is Nothing Then Set lastCOut = Range("Outputtable[UPC]").cells(1).Offset(-1)
If Not lastC Is Nothing Then
arr = Range(Range("Inputtable[UPC]").cells(1), lastC).Value
If IsArray(arr) Then
lastCOut.Offset(1).resize(UBound(arr), 1).Value = arr
Else
lastCOut.Offset(1).Value = arr
End If
End If
End Sub
在最后一种情况下,如果粘贴的行数大于 table 行,table 将扩展为必要的行.
如果有什么不清楚的,请不要犹豫,要求澄清。
我认为您的代码的问题在于它带来了不必要的复杂性。 您所要做的就是 select 您需要最后一个单元格值的列 header。转到最后一个单元格,将其复制并粘贴到所需位置。
您可以尝试复制最后一个单元格值:
Range("inputtable[[#Headers],[UPC]]").Select
Selection.End(xlDown).Select
Selection.Copy
复制ExcelTable列(ListColumn
)
- 这会将数据从一个 table 的列附加到另一个 table 的列。希望后者 table 的其余列有公式,这些公式会得到更新,以使其有意义。
- Input 部分的前 4 行说明如何分层引用各种对象,而最后 4 行说明如何引用最后一个 non-blank 单元格(
ilCell
) 和从第一列单元格到最后一个 non-blank 单元格的范围 (irg
)。
Option Explicit
Sub PurshToOutput()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Input
Dim iws As Worksheet: Set iws = wb.Worksheets("INPUT")
Dim itbl As ListObject: Set itbl = iws.ListObjects("Inputtable")
Dim ilcl As ListColumn: Set ilcl = itbl.ListColumns("UPC")
Dim irg As Range: Set irg = ilcl.DataBodyRange
' The Last Non-Blank Cell
Dim ilCell As Range: Set ilCell = irg.Find("*", , xlValues, , , xlPrevious)
If ilCell Is Nothing Then Exit Sub ' no data in column
Dim irCount As Long: irCount = ilCell.Row - irg.Row + 1
' The Range From the First Cell to the Last Cell
Set irg = irg.Resize(irCount)
' Output
Dim ows As Worksheet: Set ows = wb.Worksheets("OUTPUT")
Dim otbl As ListObject: Set otbl = ows.ListObjects("Outputtable")
Dim olcl As ListColumn: Set olcl = otbl.ListColumns("UPC")
Dim ofcell As Range
With olcl.DataBodyRange
Set ofcell = .Cells(.Cells.Count).Offset(1)
End With
Dim org As Range: Set org = ofcell.Resize(irg.Rows.Count)
' Copy by Assignment
org.Value = irg.Value
End Sub