- Katılım
- 16 Mart 2005
- Mesajlar
- 63
Ekteki dosyayı inceleyebilirseniz sevinirim. Yardımlarınız için teşekkürler.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sayın Korhan Ayhan,Selamlar,
Forumda en çok işlenen konulardan birisidir. Aşağıdaki linki incelerseniz sorunuza çözüm bulabilirsiniz.
http://www.excel.web.tr/search.php?searchid=628082&pp=15
Sub TEKRARLARI_BUL()
[C2:C65536].ClearContents
For X = 2 To [A65536].End(3).Row
If Cells(X, 1) <> "" And Cells(X, 2) <> "" Then
If WorksheetFunction.CountIf(Columns(1), Cells(X, 1)) > 1 Then
Set BUL = Columns(1).Find(Cells(X, 1), LookAt:=xlWhole)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
If Cells(X, 2) <> Cells(BUL.Row, 2) Then
Cells(X, 3) = IIf(Cells(X, 3) = "", Cells(BUL.Row, 2), Cells(X, 3) & " - " & Cells(BUL.Row, 2))
End If
Set BUL = Columns(1).FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
End If
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub