将可见数据从一个过滤列复制到与值相同的 sheet 中的另一列

Question

我无法将可见单元格从筛选数据列 (T) 复制到同一 sheet 中的另一列 (Q)。我已经尝试过这种方法，但我正在处理的数据超过 100,000 列，并且逐行处理需要很长时间。我探索过的另一种选择是手动将 Q 的公式更改为 =T，但我不知道如何将其实现为 VBA，因为我是新手。

Option Explicit
Sub Test1()


Dim ws As Worksheet: Set ws = ActiveSheet


ws.Range("$A", ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=19, Criteria1:= _
    "=NMCM", Operator:=xlOr, Criteria2:="=Houses"
ws.Range("$A", ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=20, Criteria1:=Array _
    ("Test1", "Test2"), _
    Operator:=xlFilterValues

' First Cell of the Data Range (in the row below headers)
Dim fCell As Range: Set fCell = ws.Range("T2")
' Last Cell of the Filtered Range
Dim lCell As Range: Set lCell = ws.Range("T" & ws.Rows.Count).End(xlUp)
' If no filtered data, the last cell will be the header cell, which
' is above the first cell. Check this with:
If lCell.Row < fCell.Row Then Exit Sub ' no filtered data

' Range from First Cell to Last Cell
Dim rg As Range: Set rg = ws.Range(fCell, lCell)

' Filtered Data Range
Dim frg As Range: Set frg = rg.SpecialCells(xlCellTypeVisible)

' Area Range
Dim arg As Range

For Each arg In frg.Areas
    ' Either copy values (more efficient (faster))...
    arg.EntireRow.Columns("Q").Value = arg.Value
    ' ... or copy values, formulas and formatting
    'arg.Copy arg.EntireRow.Columns("Y")
Next arg

End Sub

Answer 1

将筛选的列写入另一个筛选的列

Option Explicit

Sub Extract_Airworthy_status()
    
    Const sfCol As Long = 19 ' S
    Const sCol As Long = 20 ' T
    Const dCol As Long = 17 ' Q
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    Dim sdrg As Range ' Source Data Range (no headers)
    With ws.Range("A1").CurrentRegion
        Set sdrg = .Columns(sCol).Resize(.Rows.Count - 1).Offset(1)
        .AutoFilter Field:=sfCol, Criteria1:="=NMCM", _
            Operator:=xlOr, Criteria2:="=Houses"
        .AutoFilter Field:=sCol, Criteria1:=Array("Test1", "Test2"), _
            Operator:=xlFilterValues
    End With
    
    Dim sdfrg As Range ' Source Data Filtered Range
    On Error Resume Next
        Set sdfrg = sdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ws.AutoFilterMode = False
    If sdfrg Is Nothing Then Exit Sub
    
    Dim cOffset As Long: cOffset = dCol - sCol
    
    Dim ddfrg As Range ' Destination Data Filtered Range
    Set ddfrg = sdfrg.Offset(, cOffset)
    ddfrg.Formula = "=" & sdfrg.Cells(1).Address(0, 0)
    
    Dim ddrg As Range ' Destination Data Range
    Set ddrg = sdrg.Offset(, cOffset)
    ddrg.Value = ddrg.Value
    
End Sub

将可见数据从一个过滤列复制到与值相同的 sheet 中的另一列

Copying visible data from one filtered column to another in the same sheet as values

excel

vba

copy

visible

autofilter

将筛选的列写入另一个筛选的列