excel - Excel 宏查找重复项并复制其相邻单元格

Question

我需要一个循环C列并找到重复值并将它们复制到col D的宏，一旦找到重复值，它将从Col A复制相邻值并将其放置在Col E中

示例所需的输出：

A                 B                C              D            E
Project1          test1            quiz1         quiz1        Project1
Project2          test2            quiz1         quiz1        Project2
Project3          test3            quiz2

Answer 1

1. 按 C 列排序
2. 遍历行并检查 selectedrow.cells(1,3)=selectedrow.cells(2,3)
3. 如果它们是相同的 C 列复制值到 D 列，对于这一行和下一行。还将该行和下一行的 A 列复制到 E 列。
4. 循环直到 selectedrow 的 c 列为空。

Answer 2

对于这种情况，我有这个子..

Sub CheckDupl()
Dim x, i, nD As Integer
Dim c As String
Dim nLimit As Integer
Dim bFound As Boolean

nLimit = 3 '--> you can change this
nD = 1

For x = 1 To 3
  Cells(x, 6) = "x"
  c = Cells(x, 3)
  bFound = False
  For n = x + 1 To nLimit
    If Not Cells(n, 6) = "x" Then
      If Cells(n, 3) = c Then
        If Not bFound Then
          bFound = True
          Cells(nD, 4) = Cells(x, 3)
          Cells(nD, 5) = Cells(x, 1)
          MsgBox n
          Cells(nD + 1, 4) = Cells(n, 3)
          Cells(nD + 1, 5) = Cells(n, 1)
          Cells(n, 6) = "x"
          nD = nD + 2
        Else
          Cells(nD, 4) = Cells(n, 3)
          Cells(nD, 5) = Cells(n, 1)
          Cells(n, 6) = "x"
          nD = nD + 1
        End If

      End If
    End If
  Next
Next
End Sub

您可以通过按钮激活.. F列用于帮助，您可以将其删除！

Answer 3

可以这样做：

Sub dp()

AR = Cells(Rows.Count, "A").End(xlUp).Row

For Each p1 In Range(Cells(1, 3), Cells(AR, 3))
    For Each p2 In Range(Cells(1, 3), Cells(AR, 3))
        If p1 = p2 And Not p1.Row = p2.Row Then
            Cells(p1.Row, 4) = Cells(p1.Row, 3)
            Cells(p2.Row, 4) = Cells(p2.Row, 3)
            Cells(p1.Row, 5) = Cells(p1.Row, 1)
            Cells(p2.Row, 5) = Cells(p2.Row, 1)
        End If
    Next p2
Next p1

End Sub

Answer 4

为什么要使用宏？为什么不只是 D 列中的这个公式？

=IF(COUNTIF(C:C,C1)>1, C1,"")

为了完成任务，E列中的这个公式：

=IF(D1="", "", A1)

我认为比 VBA 更容易，处理速度也更快。