如何使用 vba 将过滤后的值仅粘贴到受此类过滤器影响的单元格中？

Question

我目前正在开发一个宏，它当前根据一个值过滤 table，然后在应用过滤器（让它工作）后复制列下的数据。但是，我无法弄清楚如何将这些值粘贴到相同的 table 中，从而覆盖不同列中可见单元格下的数据。正在复制以红色（图片）突出显示的值，现在我只需要将它们粘贴到以黄色突出显示的单元格中。谢谢！

Public Sub DxcDateUpdate()
Application.ScreenUpdating = False
Dim Mwb As Workbook
Dim ws As Worksheet

Set Mwb = ThisWorkbook
Set ws = Mwb.Worksheets("Commission")
Set ws2 = Mwb.Worksheets("test")
        
        
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws.Range("A1").AutoFilter Field:=31, Criteria1:="DXC/TPV.com Enrollment"
ws.Range("AG2:AG" & lr).SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range '''here is where idk what to do?'''
    
Application.ScreenUpdating = True
End Sub

Answer 1

您不能将不连续的范围粘贴为不连续的。您应该在每个范围单元格之间迭代并使用偏移量复制它，或者使用 c.row 构建要粘贴的范围。请尝试下一个改编代码：

Sub DxcDateUpdate()
Dim Mwb As Workbook, ws As Worksheet, rngVis As Range, c As Range, LR As Long

Set Mwb = ThisWorkbook
Set ws = Mwb.Worksheets("Commission")
Set ws2 = Mwb.Worksheets("test")
        
        
LR = ws.cells(ws.rows.Count, 1).End(xlUp).row
ws.Range("A1").AutoFilter field:=31, Criteria1:="DXC/TPV.com Enrollment"
Set rngVis = ws.Range("AG2:AG" & LR).SpecialCells(xlCellTypeVisible) 
 For Each c In rngVis.cells
    c.Offset(0, -28).value = c.value
 Next
End Sub

为了让代码更快，当然应该使用一些优化线(ScreenUpdating = False, EnableEvents = False, Calculation = xlCalculationManual, 之后是True, True, xlCalculationAutomatic).

Answer 2

使用数组复制 'Filtered' 个值

以下将循环遍历条件列以查找条件（字符串）。找到后，在同一行中，源列中的值将被复制到目标列。
列的值被写入数组以加速处理（循环）。

Option Explicit

Sub DxcDateUpdate()
    
    Const wsName As String = "Commission"
    Const fRow As Long = 2
    Const cCol As String = "AE" ' Criteria
    Const sCol As String = "AG" ' Source
    Const dCol As String = "E"  ' Destination
    Const Criteria As String = "DXC/TPV.com Enrollment"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    Dim lRow As Long: lRow = rg.Rows.Count
    
    Dim cData As Variant: cData = rg.Columns(cCol).Value
    Dim sData As Variant: sData = rg.Columns(sCol).Value
    
    With rg.Columns(dCol)
        Dim dData As Variant: dData = .Value
        Dim r As Long
        For r = fRow To lRow
            If cData(r, 1) = Criteria Then
                dData(r, 1) = sData(r, 1)
            End If
        Next r
        .Value = dData
    End With
    
End Sub

如何使用 vba 将过滤后的值仅粘贴到受此类过滤器影响的单元格中？

How do you paste filtered values only in the cells that were affected by such filter using vba?

excel

vba

copy

paste

使用数组复制 'Filtered' 个值