Koşullu Biçimlendirme (DÜZENLENDİ)

Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Ben gönderdiğiniz anlam adlı sayfaya bakarak yapmaya çalışmıştım, hata yapmış olabilirim.
Son cevabımdaki NOT kısmını o yüzden yazdım zaten.
Koddaki Range("I2:AQ" & son).Interior.Pattern = xlNone satırına kadarki kısım eski renkleri siliyor ve en sağa 44, 45'inci sütunlara ilk yarı skorlarını, 46 ve 47'nci sütunlara ise maç sonucu skorlarını ayrıştırıyor.
Örneğin kod'un
Kod: 
 If Cells(a, 46) [B][COLOR="Red"]>[/COLOR][/B] Cells(a, 47) Then
        Cells(a, 9).Interior.ColorIndex = 4
kısmı şunu diyor, a satırında (2'den başlayarak belgedeki son satır numarasına kadarki satır numarası) 46'ncı sütundaki değer 47'nci sütundaki değerden büyük ise o satırdaki 9'uncu sütundaki hücreyi (örneğin a 2 ise I2 hücresini) boya,,,,, bu şekilde kod'daki Next satırına kadar işlem yapılıyor sonra tekrar başa dönülüp bu sefer a değeri 3 (satır no) olarak dikkate alınıp tek tek tekrar kontrol ve boyama yapılıyor.
Kod'un en sonlarında (başta da var ama o şimdilik kalsın) Range("AR:AU").ClearContents şeklinde satır var, o satırın başına tek tırnak ekleyin (satır yazı rengi yeşile döner), böylece skorların ayrıştırılmış halini AR:AS (yani 44 ve 45'inci sütun) arasında ilk yarı skorlarını, AT:AU (yani 46 ve 47'nci sütun) maç sonucu skorlarını göreceksiniz.
 
Son düzenleme:
K

koberoy

Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
omer.baran' Alıntı:
Ben gönderdiğiniz anlam adlı sayfaya bakarak yapmaya çalışmıştım, hata yapmış olabilirim.
Son cevabımdaki NOT kısmını o yüzden yazdım zaten.
Koddaki Range("I2:AQ" & son).Interior.Pattern = xlNone satırına kadarki kısım eski renkleri siliyor ve en sağa 44, 45'inci sütunlara ilk yarı skorlarını, 46 ve 47'nci sütunlara ise maç sonucu skorlarını ayrıştırıyor.
Örneğin kod'un
Kod: 
 If Cells(a, 46) [B][COLOR="Red"]>[/COLOR][/B] Cells(a, 47) Then
        Cells(a, 9).Interior.ColorIndex = 4
kısmı şunu diyor, a satırında (2'den başlayarak belgedeki son satır numarasına kadarki satır numarası) 46'ncı sütundaki değer 47'nci sütundaki değerden büyük ise o satırdaki 9'uncu sütundaki hücreyi (örneğin a 2 ise I2 hücresini) boya,,,,, bu şekilde kod'daki Next satırına kadar işlem yapılıyor sonra tekrar başa dönülüp bu sefer a değeri 3 (satır no) olarak dikkate alınıp tek tek tekrar kontrol ve boyama yapılıyor.
Kod'un en sonlarında (başta da var ama o şimdilik kalsın) Range("AR:AU").ClearContents şeklinde satır var, o satırın başına tek tırnak ekleyin (satır yazı rengi yeşile döner), böylece skorların ayrıştırılmış halini AR:AS (yani 44 ve 45'inci sütun) arasında ilk yarı skorlarını, AT:AU (yani 46 ve 47'nci sütun) maç sonucu skorlarını göreceksiniz.
Genişletmek için tıkla ...
Yazdığını kodun renklendirme kısmını az çok anladım fakat ilk yolladığınız kod yeni yolladığınıza göre daha iyi. Önceki mesajda dediğim gibi bazı bölümlerdeki renklendirmeler vardı bazıları yoktu. Bunda ise çifte şans bölümü yok alt-üst bölümleri de karışmış ters olmuş. Ben kurcaladım fakat beceremedim..
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Sütun başlıklarının anlamlarını gönderdiğiniz belgeyi tekrar gözden geçirir misiniz, sanki ikl yarı/maç sonu karışıklığı var gibiydi.
Sayın koberoy, anlamanız gereken bir şey var, siz "çifte şans" deyince, belgeyi veya olayı bilmeyen birinin bir şey anlaması mümkün değil, sütun adı ve skor durumuna göre net ifadelerde bulunmalısınız.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Alternatif olarak aşağıdaki kodu deneyiniz.

200.000 satırlık veriyi 90 saniyede renklendiriyor.

Kod: 
Option Explicit

Sub Renklendir()
    Dim Son As Long, X As Long, Zaman As Double
    Dim Renk, Mac_Sonucu_A, Mac_Sonucu_B
    Dim Ilk_Yari_Sonucu_A, Ilk_Yari_Sonucu_B
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        Range("I2:AQ" & Son).Interior.Color = xlNone
        Renk = RGB(102, 255, 102)
        
        For X = 2 To Son
            If InStr(1, Cells(X, "E"), "-") > 0 Then
                Mac_Sonucu_A = Val(Split(Replace(Cells(X, "E"), " ", ""), "-")(0))
                Mac_Sonucu_B = Val(Split(Replace(Cells(X, "E"), " ", ""), "-")(1))
            End If
            If InStr(1, Cells(X, "G"), "-") > 0 Then
                Ilk_Yari_Sonucu_A = Val(Split(Replace(Cells(X, "G"), " ", ""), "-")(0))
                Ilk_Yari_Sonucu_B = Val(Split(Replace(Cells(X, "G"), " ", ""), "-")(1))
            End If
            
            If Mac_Sonucu_A > Mac_Sonucu_B Then
                Cells(X, "I").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "J").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A < Mac_Sonucu_B Then
                Cells(X, "K").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A > Ilk_Yari_Sonucu_B Then
                Cells(X, "L").Interior.Color = Renk
            End If
        
            If Ilk_Yari_Sonucu_A = Ilk_Yari_Sonucu_B Then
                Cells(X, "M").Interior.Color = Renk
            End If
        
            If Ilk_Yari_Sonucu_A < Ilk_Yari_Sonucu_B Then
                Cells(X, "N").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A > Mac_Sonucu_B Or Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "R").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A > Mac_Sonucu_B Or Mac_Sonucu_A < Mac_Sonucu_B Then
                Cells(X, "S").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A < Mac_Sonucu_B Or Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "T").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A > 0 And Mac_Sonucu_B = 0 Or Mac_Sonucu_A = 0 And Mac_Sonucu_B > 0 Then
                Cells(X, "U").Interior.Color = Renk
            End If
            
            If Mac_Sonucu_A > 0 And Mac_Sonucu_B > 0 Then
                Cells(X, "V").Interior.Color = Renk
            End If
            
            If (Ilk_Yari_Sonucu_A + Ilk_Yari_Sonucu_B) >= 0 Then
                Cells(X, "W").Interior.Color = Renk
            End If
            
            If (Ilk_Yari_Sonucu_A + Ilk_Yari_Sonucu_B) >= 2 Then
                Cells(X, "X").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) < 2 Then
                Cells(X, "Y").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) > 2 Then
                Cells(X, "Z").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) < 3 Then
                Cells(X, "AA").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) > 3 Then
                Cells(X, "AB").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) < 4 Then
                Cells(X, "AC").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) >= 4 Then
                Cells(X, "AD").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) <= 1 Then
                Cells(X, "AE").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) >= 2 And (Mac_Sonucu_A + Mac_Sonucu_B) <= 3 Then
                Cells(X, "AF").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) >= 4 And (Mac_Sonucu_A + Mac_Sonucu_B) <= 6 Then
                Cells(X, "AG").Interior.Color = Renk
            End If
            
            If (Mac_Sonucu_A + Mac_Sonucu_B) >= 7 Then
                Cells(X, "AH").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A > Ilk_Yari_Sonucu_B And Mac_Sonucu_A > Mac_Sonucu_B Then
                Cells(X, "AI").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A = Ilk_Yari_Sonucu_B And Mac_Sonucu_A > Mac_Sonucu_B Then
                Cells(X, "AJ").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A < Ilk_Yari_Sonucu_B And Mac_Sonucu_A > Mac_Sonucu_B Then
                Cells(X, "AK").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A > Ilk_Yari_Sonucu_B And Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "AL").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A = Ilk_Yari_Sonucu_B And Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "AM").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A < Ilk_Yari_Sonucu_B And Mac_Sonucu_A = Mac_Sonucu_B Then
                Cells(X, "AN").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A > Ilk_Yari_Sonucu_B And Mac_Sonucu_A < Mac_Sonucu_B Then
                Cells(X, "AO").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A = Ilk_Yari_Sonucu_B And Mac_Sonucu_A < Mac_Sonucu_B Then
                Cells(X, "AP").Interior.Color = Renk
            End If
            
            If Ilk_Yari_Sonucu_A < Ilk_Yari_Sonucu_B And Mac_Sonucu_A < Mac_Sonucu_B Then
                Cells(X, "AQ").Interior.Color = Renk
            End If
        Next
    End If

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000") & " Saniye"
End Sub
 
K

koberoy

Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Excel bilgim baya zayıf olduğu için çok soru soruyorum kusura bakmayın ama "Subscript out of range" diye bir uyarı alıyorum..

Ekleme: Buradaki "Renk"yazan bölüme renk kodlarından birini mi ekleyeceğim ?
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Eklediğiniz örnek dosyanızda hata vermeden sonuç aldım.

Renk tanımlaması da sizin örnek dosyanızda ki açık yeşil rengini ifade etmektedir. Farklı sayısal değerler girerek istediğiniz rengi kullanabilirsiniz.

Ayrıca her mesajınızda ALINTI yapmanıza gerek yok. Gerçekten alıntı yapmanız gerektiğinde bu özelliği kullanınız.
 
K

koberoy

Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Hatalarımdan dolayı özür diliyorum sizden fakat hala aynı sıkıntı var bende. Ama kodu yazan sizsiniz sizde bir sıkıntı olmamasına rağmen bende nasıl oluyor anlamadım gitti..
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu durumda uyguladığınız dosyayı ekleyin kontrol edelim.
 
K

koberoy

Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Attığım örnek dosyada da denedim aynı şey oldu. Dosyanın boyutu biraz büyük ama yinede atayım.

Link

Bu dosya da örnek dosyanın aynısı sayılır. Tüm maçların yer aldığı excel bu..
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Sayın AYHAN'ın müsadeleriyle.
Asıl belgenizde bir de aşağıdaki kod'u çalıştırır mısınız?
Hem hız ve hem de doğruluk bakımından kontrol ediniz.

Biraz dolambaçlı ve amatörce ama denemek de yarar var diye düşünüyorum.
Kod: 
Sub BARAN()
son = [A1000000].End(3).Row
Zaman = Timer
Range("AR:AU").ClearContents
Range("H1") = "İŞLEM YAPILIRKEN BEKLEYİN"
Application.Calculation = xlCalculationManual
Range("I2:AQ" & son).Interior.Pattern = xlNone
Application.Wait (Now + TimeValue("0:00:01"))

Application.ScreenUpdating = False
    For i = 2 To son
        a = Split(Cells(i, 7), "-")
        If UBound(a) > 0 Then
            For ii = 0 To UBound(a)
                Cells(i, ii + 44) = Trim(a(ii))
            Next ii
        End If
    Next i
    
    For i = 2 To son
        a = Split(Cells(i, 5), "-")
        If UBound(a) > 0 Then
            For ii = 0 To UBound(a)
                Cells(i, ii + 46) = Trim(a(ii))
            Next ii
        End If
    Next i
Range("I2:AQ" & son).Interior.Pattern = xlNone


With Range("AV2:AV" & son)
    .Formula = "=IF(AT2>AU2,1,"""")"
    .Value = .Value
End With
    
With Range("AW2:AW" & son)
    .Formula = "=IF(AT2=AU2,1,"""")"
    .Value = .Value
End With
    
With Range("AX2:AX" & son)
    .Formula = "=IF(AU2>AT2,1,"""")"
    .Value = .Value
End With
    
With Range("AY2:AY" & son)
    .Formula = "=IF(AR2>AS2,1,"""")"
    .Value = .Value
End With
    
With Range("AZ2:AZ" & son)
    .Formula = "=IF(AR2=AS2,1,"""")"
    .Value = .Value
End With
    
With Range("BA2:BA" & son)
    .Formula = "=IF(AR2<AS2,1,"""")"
    .Value = .Value
End With
    
With Range("BB2:BB" & son)
    .Formula = "=IF(OR(AT2=AU2,AT2>AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BC2:BC" & son)
    .Formula = "=IF(OR(AT2>AU2,AT2<AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BD2:BD" & son)
    .Formula = "=IF(OR(AT2=AU2,AT2<AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BE2:BE" & son)
    .Formula = "=IF(OR(AND(AT2=0,AU2>0),AND(AU2=0,AT2>0)),1,"""")"
    .Value = .Value
End With
    
With Range("BF2:BF" & son)
    .Formula = "=IF(AND(AT2>0,AU2>0),1,"""")"
    .Value = .Value
End With
    
With Range("BG2:BG" & son)
    .Formula = "=IF(AR2+AS2<2,1,"""")"
    .Value = .Value
End With
    
With Range("BH2:BH" & son)
    .Formula = "=IF(AR2+AS2>1,1,"""")"
    .Value = .Value
End With
    
With Range("BI2:BI" & son)
    .Formula = "=IF(AT2+AU2<2,1,"""")"
    .Value = .Value
End With
    
With Range("BJ2:BJ" & son)
    .Formula = "=IF(AT2+AU2>2,1,"""")"
    .Value = .Value
End With
    
With Range("BK2:BK" & son)
    .Formula = "=IF(AT2+AU2<3,1,"""")"
    .Value = .Value
End With
    
With Range("BL2:BL" & son)
    .Formula = "=IF(AT2+AU2>3,1,"""")"
    .Value = .Value
End With
    
With Range("BM2:BM" & son)
    .Formula = "=IF(AT2+AU2<4,1,"""")"
    .Value = .Value
End With
    
With Range("BN2:BN" & son)
    .Formula = "=IF(AT2+AU2>3,1,"""")"
    .Value = .Value
End With
    
With Range("BO2:BO" & son)
    .Formula = "=IF(AT2+AU2<2,1,"""")"
    .Value = .Value
End With
    
With Range("BP2:BP" & son)
    .Formula = "=IF(AND(AT2+AU2>1,AT2+AU2<4),1,"""")"
    .Value = .Value
End With
    
With Range("BQ2:BQ" & son)
    .Formula = "=IF(AND(AT2+AU2>3,AT2+AU2<7),1,"""")"
    .Value = .Value
End With
    
With Range("BR2:BR" & son)
    .Formula = "=IF(AT2+AU2>=7,1,"""")"
    .Value = .Value
End With
    
With Range("BS2:BS" & son)
    .Formula = "=IF(AND(AR2>AS2,AT2>AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BT2:BT" & son)
    .Formula = "=IF(AND(AR2=AS2,AT2>AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BU2:BU" & son)
    .Formula = "=IF(AND(AR2<AS2,AT2>AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BV2:BV" & son)
    .Formula = "=IF(AND(AR2>AS2,AT2=AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BW2:BW" & son)
    .Formula = "=IF(AND(AR2=AS2,AT2=AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BX2:BX" & son)
    .Formula = "=IF(AND(AR2<AS2,AT2=AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BY2:BY" & son)
    .Formula = "=IF(AND(AR2>AS2,AT2<AU2),1,"""")"
    .Value = .Value
End With
    
With Range("BZ2:BZ" & son)
    .Formula = "=IF(AND(AR2=AS2,AT2<AU2),1,"""")"
    .Value = .Value
End With
    
    
With Range("CA2:CA" & son)
    .Formula = "=IF(AND(AR2<AS2,AT2<AU2),1,"""")"
    .Value = .Value
End With
    
Range("A1").AutoFilter
Range("A1:CA1").AutoFilter Field:=48, Criteria1:=1
Range("I2:I" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=49, Criteria1:=1
Range("j2:j" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=50, Criteria1:=1
Range("K2:K" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=51, Criteria1:=1
Range("L2:L" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=52, Criteria1:=1
Range("M2:M" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=53, Criteria1:=1
Range("N2:N" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=54, Criteria1:=1
Range("R2:R" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=55, Criteria1:=1
Range("S2:S" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=56, Criteria1:=1
Range("T2:T" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=57, Criteria1:=1
Range("U2:U" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=58, Criteria1:=1
Range("V2:V" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=59, Criteria1:=1
Range("W2:W" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=60, Criteria1:=1
Range("X2:X" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=61, Criteria1:=1
Range("Y2:Y" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=62, Criteria1:=1
Range("Z2:Z" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=63, Criteria1:=1
Range("AA2:AA" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=64, Criteria1:=1
Range("AB2:AB" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=65, Criteria1:=1
Range("AC2:AC" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=66, Criteria1:=1
Range("AD2:AD" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=67, Criteria1:=1
Range("AE2:AE" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=68, Criteria1:=1
Range("AF2:AF" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=69, Criteria1:=1
Range("AG2:AG" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=70, Criteria1:=1
Range("AH2:AH" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=71, Criteria1:=1
Range("AI2:AI" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=72, Criteria1:=1
Range("AJ2:AJ" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=73, Criteria1:=1
Range("AK2:AK" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=74, Criteria1:=1
Range("AL2:AL" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=75, Criteria1:=1
Range("AM2:AM" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=76, Criteria1:=1
Range("AN2:AN" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=77, Criteria1:=1
Range("AO2:AO" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=78, Criteria1:=1
Range("AP2:AP" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=79, Criteria1:=1
Range("AQ2:AQ" & son + 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
ActiveSheet.ShowAllData

Range("A1:CA1").AutoFilter Field:=5, Criteria1:="v"
Range("A2:AQ" & son + 1).SpecialCells(xlCellTypeVisible).Interior.Pattern = xlNone
ActiveSheet.ShowAllData

Range("AR:CA").ClearContents
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("H1") = "LİG"
Range("A1").AutoFilter

MsgBox "İŞLEM TAMAMLANDI." & Chr(10) & "İŞLEM SÜRESİ  : " & Format(Timer - Zaman, "0.00") & "  SANİYE", vbInformation
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Eklediğiniz son dosyada "v" ve boş olan sonuçlar var. Bu ilk eklediğiniz örnek dosyada yok. Bu sebeple hata oluşuyor.

#24 nolu mesajımda ki koda küçük eklemeler yaptım. Tekrar deneyiniz.

Son eklediğiniz dosyanızda 70 saniyede sonuç aldım.

Ömer bey sizin önerdiğiniz son kodlar yaklaşık olarak 250 saniyede sonuç üretti.
 
M

mozicim

Katılım
24 Kasım 2014
Mesajlar
4
Excel Vers. ve Dili
2010,TR
Altın Üyelik Bitiş Tarihi
13.02.2021
Tablodaki druumu şöyle değiştirebilir miyiz
1. tabloyu google drive yada vb. bir yere atsak verileri oradan çeksek ama çekerken örnek olarak 2. satırdaki oranların tamamını seçerek eş değerlerini çekebilir miyiz?
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst