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

对C列进行排序
遍历行并检查selectedrow.cells（1,3）= selectedrow.cells（2,3）
如果它们是列C到列D的相等复制值，则对于该行和下一行。同时将A列复制到此行和下一行的E列。
循环，直到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更容易，处理速度也会更快，我想。

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

4 个答案: