Wątek przeniesiony 2021-09-16 10:21 z Inne języki programowania przez cerrato.

Wyszukiwarka duplikatów.

0

Witam,

Poniższe macro w pierszej kolejnosci kopiuje dane do innego arkuszu a nastepnie szuka duplikatów w kolumnie A porównujac do kolumny B a nastepnie usuwa je z kolumny A. Jednak potrzebuje zeby również usuwał dane z kolumny B. Na przykład jesli zostanie wykryty duplikat w komórce A10 to żęby również usunął komórke B10. Poniżej przeklejam kod.

Set Des = ActiveWorkbook.Worksheets("Des")
Set Copy1 = ActiveWorkbook.Worksheets("Copy1")
Sheet1.Range("A1:A200").Copy Destination:=Des.Range("A1")
Sheet1.Range("B1:B200").Copy Destination:=Des.Range("B1")
Copy1.Range("E1:E200").Copy Destination:=Des.Range("C1")


' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False


' Get count of records to search through (list that will be deleted).
iListCount = Sheets("Des").Range("A1:A10").Rows.Count


' Loop through the "master" list.
For Each x In Sheets("Des").Range("C1:C200")
' Loop through all records in the second list.
For iCtr = 1 To iListCount
' Do comparison of next record.
' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Des").Cells(iCtr, 3).Value Then
' If match is true then delete row.
Sheets("Des").Cells(iCtr, 1).Delete xlShiftUp
' Increment counter to account for deleted row.
iCtr = iCtr + 1
End If
Next iCtr


Next


Application.ScreenUpdating = True
0

Dla dwustu rekordów, to szkoda kodu. Zrób formułę wyszukującą duplikaty (coś w deseń LICZ.WARUNKI) zarówno dla kolumny A i B, a następnie zamień na wartości (kopiuj - wklej specjalnie wartości), a potem usuń tam, gdzie masz coś większe niż 1.

1 użytkowników online, w tym zalogowanych: 0, gości: 1