- 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
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
