• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makroda düzeltme ?

Katılım
8 Mart 2009
Mesajlar
504
Excel Vers. ve Dili
2010
Option Explicit

Sub ALFABETİK_SIRALI_BENZERSİZ_LİSTE()
Dim X As Long, Satır As Long, Son_Satır As Long

Application.ScreenUpdating = False

Range("K2:L65536").ClearContents
X = 2
Satır = 2
Son_Satır = Range("C65536").End(3).Row + 1

Do Until X = Son_Satır
If Cells(X, "C") <> "" And Cells(X, "C") <> "ADI SOYADI" Then
If WorksheetFunction.CountIf(Range("K:K"), Cells(X, "C")) = 0 Then
Cells(Satır, "K") = Cells(X, "C")
If WorksheetFunction.CountIf(Range("C:C"), Cells(Satır, "K")) > 1 Then
Cells(Satır, "L") = "*"
End If
Satır = Satır + 1
End If
End If
X = X + 1
Loop

Columns("K:L").Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlYes
Columns("K:K").EntireColumn.AutoFit

Application.ScreenUpdating = True

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub










bununla isimlerde mükerrer olanları buluyoruz birde isimler C2 den aşağıya doğru gidiyor isimleri K2 den itibaren yazıp mükerrer olanların yanına (*) işareti koyuyor B2 den itibaren asıl listeyi yapıştırıp C2 ile karşılaştırıp, olmayanları D2 den itibaren yazdırmak için nasıl bir değişiklik yapmam gerekli
 
Geri
Üst