Всем здравствуйте.Уважаемые форумчане помогите реализовать данную задачу. Есть 3 столбца со значениями необходимо сравнить по первому столбцу наличие дубликатов во втором и в третьем столбце В итоге должно остаться 1 столбец не тронутый второй и третий без дублей Пример прикладываю Нашел вот такой макрос но он сравнивает и удаляет только по двум столбцам Sub Main() [ Dim i As Long, j As Long, x As New Collection, a(), b(), c() Application.ScreenUpdating = False a = Range([A1], Cells(Rows.Count, "A").End(xlUp)).Value b = Range([B1], Cells(Rows.Count, "B").End(xlUp)).Value On Error Resume Next For i = 1 To UBound(a, 1): x.Add a(i, 1), CStr(a(i, 1)): Next On Error GoTo 0: ReDim c(1 To UBound(b, 1), 1 To 1): j = 1 For i = 1 To UBound(b, 1) On Error Resume Next: x.Add b(i, 1), CStr(b(i, 1)) If Err = 0 Then c(j, 1) = b(i, 1): j = j + 1 Else: On Error GoTo 0 End If Next Range([B1], Cells(UBound(c, 1), "B")).Value = c End Sub ]
Всем здравствуйте.Уважаемые форумчане помогите реализовать данную задачу. Есть 3 столбца со значениями необходимо сравнить по первому столбцу наличие дубликатов во втором и в третьем столбце В итоге должно остаться 1 столбец не тронутый второй и третий без дублей Пример прикладываю Нашел вот такой макрос но он сравнивает и удаляет только по двум столбцам Sub Main() [ Dim i As Long, j As Long, x As New Collection, a(), b(), c() Application.ScreenUpdating = False a = Range([A1], Cells(Rows.Count, "A").End(xlUp)).Value b = Range([B1], Cells(Rows.Count, "B").End(xlUp)).Value On Error Resume Next For i = 1 To UBound(a, 1): x.Add a(i, 1), CStr(a(i, 1)): Next On Error GoTo 0: ReDim c(1 To UBound(b, 1), 1 To 1): j = 1 For i = 1 To UBound(b, 1) On Error Resume Next: x.Add b(i, 1), CStr(b(i, 1)) If Err = 0 Then c(j, 1) = b(i, 1): j = j + 1 Else: On Error GoTo 0 End If Next Range([B1], Cells(UBound(c, 1), "B")).Value = c End Sub ]Silwer