• DİKKAT

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

Formül ile renge göre sıralama yapma

E

enes309

Katılım
2 Eylül 2016
Mesajlar
23
Excel Vers. ve Dili
Excel 2016
Koşullu biçimlendirmeden yaptığım benzersizleri en üste alıp silmem lazım ama normal yapmaya çalıştığımda excel yanıt vermiyor ve donuyor. 165k satır var ondan muhtemelen. Formul veya macro ile belki donmaz diye düşündüm. Yardımcı olabilecek varsa çok iyi olur
 
Merhaba ,

Örnek bir dosya yüklerseniz eğer yardımcı olmaya çalışırım :)
 
Merhaba.

1) MAKRO kullanarak:
Aşağıdaki kodların işinizi görmesi lazım.

-- alt taraftan uygulama istediğiniz sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağ tarafa aşağıdaki kod'u yapıştırın,
-- VBA ekranında iken F5 tuşuna basarak kod'un çalışmasını sağlayın.
.
Kod: 
[FONT="Arial Narrow"][B]Sub BENZERSİZLER()[/B]
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
For sut = 2 To 3
    For sat = [A1048576].End(3).Row To 1 Step -1
        If WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut)) > 1 Then
        aranan = Cells(sat, sut): Cells(sat, sut).Activate
            For adet = 1 To WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut))
                Cells.Find(What:=aranan, After:= _
                ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select
                Selection.Delete Shift:=xlUp: Next: End If: Next: Next
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI..."
[B]End Sub[/B][/FONT]
2) FORMÜL KULLANARAK (D ve E sütununda listelemek için):
Aşağıdaki dizi formüllerini kullanabilirsiniz.
Formüller dizi formülü olduğundan belgenizi biraz yavaşlatabilir.
İşlem öncesi koşullu biçimlendirmeleri kaldırmanızı öneririm.

-- Aşağıdaki ilk dizi formülünü D1 hücresine, ikinci dizi formülünü de E1 hücresine
uygulayın ve boş sonuç elde edinceye kadar her iki hücreyi aşağı doğru kopyalayın.
.
Kod: 
=EĞERHATA(İNDİS($B$1:$B$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$B$1:$B$207)=1;SATIR($B$1:$B$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
Kod: 
=EĞERHATA(İNDİS($C$1:$C$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$C$1:$C$207)=1;SATIR($C$1:$C$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
 
Ömer BARAN' Alıntı:
Merhaba.

1) MAKRO kullanarak:
Aşağıdaki kodların işinizi görmesi lazım.

-- alt taraftan uygulama istediğiniz sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağ tarafa aşağıdaki kod'u yapıştırın,
-- VBA ekranında iken F5 tuşuna basarak kod'un çalışmasını sağlayın.
.
Kod: 
[FONT="Arial Narrow"][B]Sub BENZERSİZLER()[/B]
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
For sut = 2 To 3
    For sat = [A1048576].End(3).Row To 1 Step -1
        If WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut)) > 1 Then
        aranan = Cells(sat, sut): Cells(sat, sut).Activate
            For adet = 1 To WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut))
                Cells.Find(What:=aranan, After:= _
                ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select
                Selection.Delete Shift:=xlUp: Next: End If: Next: Next
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI..."
[B]End Sub[/B][/FONT]
2) FORMÜL KULLANARAK (D ve E sütununda listelemek için):
Aşağıdaki dizi formüllerini kullanabilirsiniz.
Formüller dizi formülü olduğundan belgenizi biraz yavaşlatabilir.
İşlem öncesi koşullu biçimlendirmeleri kaldırmanızı öneririm.

-- Aşağıdaki ilk dizi formülünü D1 hücresine, ikinci dizi formülünü de E1 hücresine
uygulayın ve boş sonuç elde edinceye kadar her iki hücreyi aşağı doğru kopyalayın.
.
Kod: 
=EĞERHATA(İNDİS($B$1:$B$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$B$1:$B$207)=1;SATIR($B$1:$B$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
Kod: 
=EĞERHATA(İNDİS($C$1:$C$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$C$1:$C$207)=1;SATIR($C$1:$C$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
Genişletmek için tıkla ...

Ömer Hocam elinize , emeğinize sağlık :)
 
Ömer BARAN' Alıntı:
Merhaba.

1) MAKRO kullanarak:
Aşağıdaki kodların işinizi görmesi lazım.

-- alt taraftan uygulama istediğiniz sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağ tarafa aşağıdaki kod'u yapıştırın,
-- VBA ekranında iken F5 tuşuna basarak kod'un çalışmasını sağlayın.
.
Kod: 
[FONT="Arial Narrow"][B]Sub BENZERSİZLER()[/B]
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
For sut = 2 To 3
    For sat = [A1048576].End(3).Row To 1 Step -1
        If WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut)) > 1 Then
        aranan = Cells(sat, sut): Cells(sat, sut).Activate
            For adet = 1 To WorksheetFunction.CountIf(Range("B:C"), Cells(sat, sut))
                Cells.Find(What:=aranan, After:= _
                ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select
                Selection.Delete Shift:=xlUp: Next: End If: Next: Next
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI..."
[B]End Sub[/B][/FONT]
2) FORMÜL KULLANARAK (D ve E sütununda listelemek için):
Aşağıdaki dizi formüllerini kullanabilirsiniz.
Formüller dizi formülü olduğundan belgenizi biraz yavaşlatabilir.
İşlem öncesi koşullu biçimlendirmeleri kaldırmanızı öneririm.

-- Aşağıdaki ilk dizi formülünü D1 hücresine, ikinci dizi formülünü de E1 hücresine
uygulayın ve boş sonuç elde edinceye kadar her iki hücreyi aşağı doğru kopyalayın.
.
Kod: 
=EĞERHATA(İNDİS($B$1:$B$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$B$1:$B$207)=1;SATIR($B$1:$B$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
Kod: 
=EĞERHATA(İNDİS($C$1:$C$207;KÜÇÜK(EĞER(EĞERSAY($B$1:$C$207;$C$1:$C$207)=1;SATIR($C$1:$C$207));SATIR());0);"")
[FONT="Arial Narrow"][COLOR="Blue"]Dizi formülü hücreye [B][COLOR="Red"]CTRL+SHIFT+ENTER[/COLOR][/B] ile uygulanmalıdır.
İşlem doğru yapılmışsa formül [B]kendiliğinden[/B] [B][COLOR="red"]{[/COLOR][/B]...[B][COLOR="red"]}[/COLOR][/B]  gibi köşeyi parankez içine alınır.[/COLOR][/FONT]
Genişletmek için tıkla ...

Çok teşekkür ederim elinize sağlık. Makroyu çalıştırabildim bekliyorum running yazıyor. Formülü anlamadım tam olarak ne yaptığını sadece 1. satırda olan B VE C dekileri D ve E ye kopyalıyor ben yaptığım zaman
 
Tekrar merhaba.

Formül ve makro ile çözümün uygulandığı belge ekte.
.
 

Ekli dosyalar

Satır sayısı fazla olan dosyalarda koşllu biçimlendirme yaptığınızda dediğiniz gibi donma oluyor

Ben yinelenen değer olup olmadığını görmek veya işlem yapmak istediğimde şu yöntemi kullanıyorum

eğersay ile ilgili hücreyi sütunda saydıyorum formülü kaldırıp istediğin işlemi yapabilirsin (benzersizler için sonucu 1 olanları sil)
eğer1 sütundan fazla sütun ise birleştirdikten sonra yine biraz önce bahsettiğimi yapabilirsin

inan exceli bekleyinceye kadar bu işlemleri bir milyon kez yaparsın
 
İhtiyaç görüldüyse mesele yok.
Kolay gelsin.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst