VBA检查重复项（列）并将单元格从一行复制到另一行重复答案

【问题标题】：VBA Check duplicates (column) and copy cells from one row to another that is duplicateVBA检查重复项（列）并将单元格从一行复制到另一行重复
【发布时间】：2016-12-22 10:27:26
【问题描述】：

Excel 2007 [VB] 在我的宏中，我按颜色过滤以查找重复值（在“J”列上，我有突出显示单元格规则 - 重复项）。 “J”列中的重复记录在“K”列中命名为“副本”或“原始”。我想为每个始终位于（但不是 1 行而是更多行）下的“原始”记录找到“副本”和将“复制”行的 N:R 列中的单元格值复制到“原始”行。

我希望我写的清楚，但如果不是截图下。

表格

我的宏开始：

Sub copy_original()
Dim lastRow As Long
Dim wb2 As Excel.Workbook

Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Application.ScreenUpdating = True

Set wb2 = ThisWorkbook

wb2.Sheets("Sheet1").AutoFilterMode = False
wb2.Sheets("Sheet1").Range("A4:U4").AutoFilter Field:=10, Criteria1:=RGB(255, 204, 0), Operator:=xlFilterCellColor

lastRow = wb2.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row

For x = lastRow To 5 Step -1
If...
...
wb2.Sheets("Sheet1").AutoFilterMode = False
End Sub

我寻找可以提供帮助的类似内容，并找到了这样的脚本：

Check if one cell contains the EXACT same data as another cell VBA

Find cells with same value within one column and return values from separate column of same row

Excel: Check if Cell value exists in Column, and return a value in the same row but different column

但老实说，我不知道如何将它连接到一个工作宏中。我将不胜感激。

【问题讨论】：

标签： excel vba

【解决方案1】：

试试这个：

子副本原件（） Dim filtersRng As Range, cl As Range, rw As Integer

Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Application.ScreenUpdating = True

With ThisWorkbook.Worksheets("Sheet1")

    .AutoFilterMode = False
    .Range("A4:U4").AutoFilter Field:=10, Criteria1:=vbRed, Operator:=xlFilterCellColor

    Set filteredRng = .Range("J5:J" & .Cells(Rows.Count, "J").End(xlUp).Row)

    For Each cl In filteredRng.SpecialCells(xlCellTypeVisible)
        If cl.Offset(0, 1) = "Original" Then
            Range("L" & rw & ":R" & rw).Copy Destination:=cl.Offset(0, 2)
        End If
        rw = cl.Row
    Next cl

    .AutoFilterMode = False
End With

结束子

【讨论】：

首先感谢您的帮助。它几乎奏效了。但问题是它被过滤了，如果有更多行，它会在原始行上方复制行（但来自未过滤模式）。它必须在“J”列中找到具有相同值的过滤模式行。并从中复制。我认为必须使用“cl.Row - 1”以外的其他内容，因为它处于过滤模式。
明白。请参阅更新的代码。使用rw 跟踪过滤范围内的行号。
完美运行！再次感谢。

【解决方案2】：

你可以试试；

For x = 5 to lastRow
   If Cells(x,11) = "Copy" Then
      For y = x+1 to LastRow
         If Cells(y,10).Value = Cells(x,10) then
            Cells(y,14) = Cells(x,14)
            Cells(y,15) = Cells(x,15)
            Cells(y,16) = Cells(x,16)
            Cells(y,17) = Cells(x,17)
            Cells(y,18) = Cells(x,18)
         End If
      Next y
   End If
Next x

【讨论】：