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

У меня есть этот сабвуфер для этого случая ..

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 2

1. сортировать по столбцу C
2. через петлю строк и проверить, если selectedrow.cells (1,3) = selectedrow.cells (2, 3)
3. , если они равны значению копирования столбца C в столбец D, как для этой строки, так и для следующей строки. также скопируйте столбец A в столбец E для этой строки и следующей строки.
4. цикл до тех пор, пока столбец c выбранных выше не будет пустым.

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,"")

И чтобы закончить задачу, эта формула в колонке Е:

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

проще, чем VBA, будет обрабатывать быстрее, а, я думаю.