根据自动过滤的列复制列，然后仅将值粘贴到该自动过滤的列

Question

我想基于“未知”之类的值过滤B列，然后过滤L列以具有非空值。复制L列。 仅将值粘贴到B列。

Before:
ColumnB ..... Column L
1 ..... a
2 ..... b
Unknown.c
3.......d
Unknown.e
Unknown.

After
1 ..... a
2 ..... b
c.......c
3.......d
e.......e
Unknown..

    Set r1 = Range("B:B").SpecialCells(xlCellTypeVisible)
    Set r2 = Range("L:L").SpecialCells(xlCellTypeVisible)
    Set myMultipleRange = Union(r1, r2)
    Application.ScreenUpdating = False
    sh1.Range("B:L").AutoFilter
    sh1.Range("B:B").AutoFilter Field:=1, Criteria1:="Unknown", Operator:=xlFilterValues

    sh1.Range("L:L").AutoFilter Field:=11, Operator:=xlFilterValues, Criteria1:="<>"

    LstRw = sh1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
    If LstRw <> 0 Then
        myMultipleRange.FillLeft
    End If

以上代码将复制并粘贴包括格式在内的内容。

Answer 1

在经过过滤的表中复制/粘贴并不是一个好主意，因为它即使在隐藏行中也连续插入数据，并弄乱了数据。

我建议以下内容：

• 过滤数据
• 遍历所有可见的单元格并逐行复制数据

如果提供以下数据……

…，并且您要用L列中的数据替换unkown，可以执行以下操作：

Option Explicit

Public Sub FilterAndCopy()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tabelle1")

    'Filter data
    ws.Range("B:B").AutoFilter Field:=1, Criteria1:="Unknown", Operator:=xlFilterValues

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    Dim DestinationRange As Range
    On Error Resume Next 'next line throws error if filter returns no data rows
    Set DestinationRange = ws.Range("B2", "B" & LastRow).SpecialCells(xlCellTypeVisible) 'find visible cells between B2 (exclude header) and last row in B
    On Error GoTo 0 'always re-activate error reporting!

    If Not DestinationRange Is Nothing Then 'do it only if there is visible data
        Dim Cell As Range
        For Each Cell In DestinationRange 'copy each value row wise
            Cell.Value = Cell.Offset(ColumnOffset:=10).Value 'column L is 10 columns right of B
        Next Cell
    End If
End Sub

Answer 2

替代解决方案-只需遍历B列中的每个单元格，然后用L列中的相应值替换“未知”。

Sub foo()
    Dim lngLastRow          As Long
    Dim rngCell             As Range

    With Sheet1
        LastRow = .Range("B" & Rows.Count).End(xlUp).Row
        For Each rngCell In .Range("B1:B" & LastRow)
            If rngCell.Value = "Unknown" Then
                rngCell.Value = .Range("L" & rngCell.Row).Value
            End If
        Next rngCell
    End With
End Sub

P.S。确保用相关的工作表名称/代码替换With Sheet1语句。