Question

我在一个名为“ DL数据计算”的工作表中有一个包含数据的表。我想将表（A21：E21）中的最高行（过滤后）复制到（Y3：AC3）。我现在面临的问题是，当我声明要过滤的范围时，仅复制单元格的A21：E21行而不是最高行。有人能帮我吗？我输入了下面使用的脚本。

Sub CopySelectionVisibleRowsEnd()
Dim ws As Worksheet
Dim mySel As Range
Dim lRow As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long

Set ws = ActiveSheet
Set mySel = Selection.EntireRow
Set myList = ActiveCell.ListObject
myListRows = myList.Range.Rows.Count
myListCols = myList.Range.Columns.Count
lRow = ws.Cells.Find(What:="*", _
    SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, _
    LookIn:=xlValues).Row + 1

mySel.SpecialCells(xlCellTypeVisible).Copy
ws.Cells(lRow, 1).PasteSpecial Paste:=xlPasteAll

lRowNew = ws.Cells.Find(What:="*", _
    SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, _
    LookIn:=xlValues).Row + 1
lRowsAdd = lRowNew - lRow

With myList
.Resize ws.Range(.Range.Resize(myListRows + lRowsAdd, myListCols).Address)
End With

Application.CutCopyMode = False
End Sub

Answer 1

我做了一些更改以创建示例数据和工作代码：

Sub CreateSampleData()
Range("A21") = "F1"
Range("B21") = "F2"
Range("C21") = "F3"
Range("D21") = "F4"
Range("E21") = "F5"
Range("A22:E62") = "=INT(RAND()*1000)"
Range("A22:E62").Copy
Range("A22").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$21:$E$62"), , xlYes).Name = "Table1"
End Sub

Sub CopySelectionVisibleRowsEnd()
Dim ws As Worksheet
Dim mySel As Range
Dim lRow As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long

Set ws = ActiveSheet 'Sheets("Tabelle1")

为什么选择此行？您是否要在此处选择第一行？该行仅选择活动选择的“ EntireRow”。

Set mySel = Selection.EntireRow

让我们继续您的代码：

Set myList = ActiveCell.ListObject
myListRows = myList.Range.Rows.Count
myListCols = myList.Range.Columns.Count
lRow = ws.Cells.Find(What:="*", _
    SearchOrder:=xlRows, _
    SearchDirection:=xlNext, _
    LookIn:=xlValues).Row + 1

'Here you copy the row of the active cell (if its visible).
'If you select a cell and make it unvisible with the filter
'you select nothing!
'mySel.SpecialCells(xlCellTypeVisible).Copy

'If you select a cell after the filter this can be copied with
'your code - first 5 cells only:
mySel.Range("A1:E1").SpecialCells(xlCellTypeVisible).Copy

' You want to paste to Cell Y3?
'ws.Cells(lRow, 1).PasteSpecial Paste:=xlPasteAll
ws.Range("Y3").PasteSpecial Paste:=xlPasteAll                  

'what is it that you want to achieve here?
lRowNew = ws.Cells.Find(What:="*", _
    SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, _
    LookIn:=xlValues).Row + 1
lRowsAdd = lRowNew - lRow

'I have no idea what you want to achieve here:
'With myList
'.Resize ws.Range(.Range.Resize(myListRows + lRowsAdd, myListCols).Address)
'End With

Application.CutCopyMode = False
End Sub

至少进行了上述更改，代码才能正常工作。
手动将光标放在任何行中->此行都将复制到范围“ Y3：AC3”

使用以下代码，我复制可见的第一行（列A到E）
现有工作表上存在的列表，并将其粘贴到
范围（Y3：AC3）。

Sub CopySelectionVisibleRowsEnd_NEW()
Dim myList As ListObject
Set myList = ActiveSheet.ListObjects(1) 'ActiveSheet.ListObjects("Table1")
Set CopyRange = myList.Range.Offset(1).SpecialCells(xlCellTypeVisible).Range("A1:E1")
CopyRange.Copy
Range("Y3").PasteSpecial Paste:=xlPasteAll
'or PasteValues:
'Range("Y3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

VBA脚本用于复制表中的最高行

1 个答案: