Нужна помощь в поиске повторяющихся значений в Excel путем сравнения данных в двух столбцах

[andreton]

Добрый день!
Сравниваем столбец А со столбцом С с помощью макроса, после выполнения повторяющиеся значения размещаются в столбец В и напротив таких же значений из столбца А.

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("C1:C5")
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x
End Sub

Помогите пожалуйста сделать макрос, который переносит повторяющиеся значения в столбец D, и размещает против таких же значений столбца С.

[IgorGO]

Sub MoveA2D()
  Dim r As Long
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(Cells(r, 1)) Then
      If WorksheetFunction.CountIf(Columns(3), Cells(r, 1)) > 0 Then
        Cells(r, 4) = Cells(r, 1): Cells(r, 1).ClearContents
      End If
    End If
  Next
End Sub

[andreton]

IgorGO, спасибо.
Но немного не так. Этот скрипт переносит из А в D дубликаты, и размещает также как они были в А, а нужно напротив значений в С !

[IgorGO]

извините, вот так исправьте:

      If WorksheetFunction.CountIf(Columns(3), Cells(r, 1)) > 0 Then
        Cells(WorksheetFunction.Match(Cells(r, 1), Columns(3), 0), 4) = Cells(r, 1): Cells(r, 1).ClearContents

[IgorGO]

или вообще сделайте так:

Sub MoveA2D()
  Dim r As Long, fnd As Range
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not IsEmpty(Cells(r, 1)) Then
      Set fnd = Columns(3).Find(Cells(r, 1), Cells(1, 3), xlValues, xlWhole)
      If Not fnd Is Nothing Then Cells(r, 1).ClearContents:  fnd.Offset(0, 1) = fnd
    End If
  Next
End Sub

[svsh2016]

доброго времени суток,Andreton,попробуйте еще такой макрос
кнопка yyy на листе Лист1 в файл-примере.

Sub yyy()
    Dim z(), z1(), i&, j&
    z = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim z1(1 To UBound(z), 1 To 1)
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 1 To UBound(z): .Item(z(i, 1)) = 0: Next
        For i = 1 To UBound(z)
        For j = 1 To UBound(z)
            If z(i, 1) = z(j, 3) And .exists(z(j, 3)) = True Then z1(j, 1) = z(j, 3)
        Next j, i
   Range("D1").Resize(UBound(z), 1) = z1
    End With
End Sub

[andreton]

Спасибо, IgorGO. Работает замечательно. К этому добавилась еще одна задача: между столбцами А и С есть пустой столбец В. Сюда вставляем два столбца с датой В и С(которые относятся к столбцу А). В столбик D цифры? с которыми нужно сравнить. Теперь данные из А полетят в Е. Нужно чтобы даты из В и С также полетели следом и расположились в F и G, помогите и с этим пожалуйста.

[andreton]

Спасибо, svsh2016