İç İçe Eğer ve VE Fonksiyonu Hak.

[bhdr]

Herkese saygılar,

Ek' te gönderdiğim dosyada C sütununda mükerrer olan hücrelerin fazlalıklarını silip hepsinden birer adet olmasını istiyorum.Bunu İç içe eğer ve ve formülü ile birlikte koşullu biçimlendirme ile piyasaya çıkartabildim.Ancak 19.000 satır var ve yeri geliyor 100.000 satırda olabiliyor sorgu kısmım.Ozaman formül işlemi yavaşlatıyor haliyle.

Bu formülün kod olarak yazılması konusunda yardımcı olabilir misiniz?

Teşekkürler.

http://www.dosya.tc/server10/3z5wgd/Eger_ve_VE.xlsx.html

 

[muygun]

Merhaba;
Dosyanızda yeni bir sayfa oluşturun.
Sayfa adını tek olarak değiştirin.
Sonra boş bir modüle;

Sub mükerrersiz1() '2.satırdan son satıra
Application.ScreenUpdating = False
On Error Resume Next
Sheets("tek").Range("a2:z65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("tek")
For i = 2 To s1.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("c2:c" & i), s1.Cells(i, "c")) = 1 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, "a") = s1.Cells(i, "c") 'tek sayfası A sütununa Sheet1 sayfası C sütun verisini yazar
s2.Cells(sonsatir, "b") = i 'alınan satır no'su
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Sub mükerrersiz2() 'son satırdan 2.satıra
Application.ScreenUpdating = False
On Error Resume Next
Sheets("tek").Range("a2:z65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("tek")
sonn = s1.Range("c65536").End(xlUp).Row
For i = sonn To 2 Step -1
If WorksheetFunction.CountIf(s1.Range("c" & sonn & ":c" & i), s1.Cells(i, "c")) = 1 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, "a") = s1.Cells(i, "c") 'tek sayfası A sütununa Sheet1 sayfası C sütun verisini yazar
s2.Cells(sonsatir, "b") = i 'alınan satır no'su
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını yerleştirin.
Her iki kodu butonlara bağlayarak çalıştırın.
hangi sonuç sizin için uygunsa ilgili kod'u kullanın.
Ben sadece C sütun verisi ve alınan satır no'sunu yazdırdım.
Siz isteğinize göre ekleme yada değişikliği yaparsınız.

İyi çalışmalar.

 

[bhdr]

Merhaba;
Dosyanızda yeni bir sayfa oluşturun.
Sayfa adını tek olarak değiştirin.
Sonra boş bir modüle;

Sub mükerrersiz1() '2.satırdan son satıra
Application.ScreenUpdating = False
On Error Resume Next
Sheets("tek").Range("a2:z65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("tek")
For i = 2 To s1.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("c2:c" & i), s1.Cells(i, "c")) = 1 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, "a") = s1.Cells(i, "c") 'tek sayfası A sütununa Sheet1 sayfası C sütun verisini yazar
s2.Cells(sonsatir, "b") = i 'alınan satır no'su
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Sub mükerrersiz2() 'son satırdan 2.satıra
Application.ScreenUpdating = False
On Error Resume Next
Sheets("tek").Range("a2:z65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("tek")
sonn = s1.Range("c65536").End(xlUp).Row
For i = sonn To 2 Step -1
If WorksheetFunction.CountIf(s1.Range("c" & sonn & ":c" & i), s1.Cells(i, "c")) = 1 Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, "a") = s1.Cells(i, "c") 'tek sayfası A sütununa Sheet1 sayfası C sütun verisini yazar
s2.Cells(sonsatir, "b") = i 'alınan satır no'su
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını yerleştirin.
Her iki kodu butonlara bağlayarak çalıştırın.
hangi sonuç sizin için uygunsa ilgili kod'u kullanın.
Ben sadece C sütun verisi ve alınan satır no'sunu yazdırdım.
Siz isteğinize göre ekleme yada değişikliği yaparsınız.

İyi çalışmalar.

Teşekkür ederim elinize sağlık.