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

Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Bir kaynağın hazırladığı Excel dosyası halinde tüm iddaa maçlarının dosyası var. Dosyada maç sonuçlarına göre tutan bahisler renklendirilmemiş halde. Ben birkaç defa skorları tek tek filtreleyip tutan bahisleri renklendiriyordum fakat dosya her bülten açıklandıktan sonra tekrar renksiz olarak yayınlanıyor ve benim uğraşlarım çöpe gidiyor. Dosya sürekli yenilerek yayınlandığı için ben bu işin bir kısayolu var mıdır diye sormak istiyorum.



Resimde gördüğünüz gibi 170.000 küsür maç var. Ben dosya yayınlandıktan hemen sonra E ve G sütunundaki skorları filtreleyip tek tek tutan bahisleri renklendirmekle uğraşıyorum. Bunun için bir makro veya koşullu biçimlendirme yapılabilir mi ? Yapılırsa nasıl bir yol izlemeliyim veya siz nasıl yardımcı olabilirsiniz ?

ÖRNEK DOSYA;

http://www.dosya.tc/server4/vj177i/ornek.xlsx.html


Resimde tüm sütunlar çıkmadı kusura bakmayın..
 
Son düzenleme:

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,713
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Elimde bir iddaa exceli var. Skorları filtreleyip tek tek renklendirmek çok zor oluyor çünkü her hafta yenileniyor. Skor sütununa göre bir biçimlendirme yapmak istiyorum tutan bahisler için. Bunun için neler yapmam gerekir ? Şimdiden teşekkürler..
Merhaba,

Küçükte olsa, açıklamalı örnek bir dosya eklemeniz önerilir.Buraya ekleyemezseniz Dosya.Tc ve benzeri yerlere ekleyin ve buraya linkini verin. Bu durumda çabuk ve doğru çözüm elde edersiniz.

Teşekkür ederim.
 

Murat OSMA

Altın Üye
Altın Üye
Katılım
23 Mayıs 2011
Mesajlar
5,508
Excel Vers. ve Dili
Microsoft 365 TR-EN
Altın Üyelik Bitiş Tarihi
31-12-2028
Dosyayı görmeden yorum yapılmaz.
 
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Link ilk mesaja eklenmiştir !

Düzenlendi !
 
Son düzenleme:
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Dosya alıntıdır bu arada. Emek hırsızlığı yapmak istemem. Biraz düzenleyip kaydedip uploadladım dosyayı.

Dosya her hafta yenileniyor. Ben her hafta renklendirme yapmak zor oluyor. Bunu nasıl kolay hale çevirebilirim ?
 
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Flood yapıyorum ama yardım edecek kimse yok mu veya bir çözümü ?
 

Ö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.
Merhabalar. Foruma hoşgeldiniz.

44 MB boyutunda bir belgenin indirilip çözüm bulunarak, çözümün buradan paylaşılması istiyorsunuz.

Yani kanaatim o ki; yardım değil, belgedeki işinizi yapacak birisini arıyorsunuz.

Böyle yapmak yerine az miktarda (ihtiyacın anlaşılır olmasını sağlayacak miktar elbette) veri ile hazırlayacağınız (alıntı diyorsunuz ama küçük bir parçasını oradan alıp yeni belge oluşturma zahmetine bile katlanmamış oluyorsunuz neticede) örnek belgeyi paylaşırsanız daha anlamlı olur bence.

Örneğin ben indirme bağlantısına fareyle tıkladım. İndirme işlemi başladığında dosya boyutunu gördüm ve indirme işlemini yarıda kestim.

Konu açılış mesajında ihtiyacı tam olarak açıklamamışsınız, umarım dosyanızı indirecekler için belge içerisinde açıklama vardır. Sanırım belgenizi indiren diğer kişiler de benim gibi düşünmüş/yapmış olmalı ki çözüm önerisi almamışsınız.

İyi günler dilerim.


Not: Bir de FLOOD YAPMAK deyiminin anlamını söylerseniz bilgilenmiş de oluruz. Yok mudur bunun TÜRKÇE'si acaba? İki Türk'ün birbiriyle Türkçe iletişim kurmasını beklemek fazla bir beklenti olmasa gerek değil mi?
 
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Merhabalar. Foruma hoşgeldiniz.

44 MB boyutunda bir belgenin indirilip çözüm bulunarak, çözümün buradan paylaşılması istiyorsunuz.

Yani kanaatim o ki; yardım değil, belgedeki işinizi yapacak birisini arıyorsunuz.

Böyle yapmak yerine az miktarda (ihtiyacın anlaşılır olmasını sağlayacak miktar elbette) veri ile hazırlayacağınız (alıntı diyorsunuz ama küçük bir parçasını oradan alıp yeni belge oluşturma zahmetine bile katlanmamış oluyorsunuz neticede) örnek belgeyi paylaşırsanız daha anlamlı olur bence.

Örneğin ben indirme bağlantısına fareyle tıkladım. İndirme işlemi başladığında dosya boyutunu gördüm ve indirme işlemini yarıda kestim.

Konu açılış mesajında ihtiyacı tam olarak açıklamamışsınız, umarım dosyanızı indirecekler için belge içerisinde açıklama vardır. Sanırım belgenizi indiren diğer kişiler de benim gibi düşünmüş/yapmış olmalı ki çözüm önerisi almamışsınız.

İyi günler dilerim.


Not: Bir de FLOOD YAPMAK deyiminin anlamını söylerseniz bilgilenmiş de oluruz. Yok mudur bunun TÜRKÇE'si acaba? İki Türk'ün birbiriyle Türkçe iletişim kurmasını beklemek fazla bir beklenti olmasa gerek değil mi?
Öncelikle yazdıklarınızın kendi düşünceniz olduğunu belirtmek isterim. Sitede yeniyim ve ilk defa YARDIM istiyorum. Konunun başında ne istediğimi düzgün bir şekilde anlatamadım onda haklısınız. Dosya istenince ben direk dosyanın kendisini attım ne olduğu görülsün diye. İşimi görmek istesem direk yapabilecek var mı diye açık açık sorarım emin olun. Excel bilgim çok sınırlı olduğu için yardım konusu açtım. Ama amacım yanlış anlaşılmış.

Yazdığınız nota cevap olarak da flood demek de benim konuya biri yazmadan arka arkaya mesaj atmam demek.

KONUYU DÜZGÜN ANLATAMADIĞIM İÇİN KONUNUN İLK MESAJINA RESİMLİ VE DOĞRU DÜZGÜN BİR AÇIKLAMA YAZIP DÜZENLİYORUM. AYRICA BOYUTU BÜYÜK OLDUĞU İÇİN DÜZENLEYİP KÜÇÜK BİR ÖRNEK DOSYASI DA EKLİYORUM. KONUYLA İLGİLENEN İLGİLENMEK İSTEYENLERİN DİKKATİNE !!!
 

Ö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.
Tekrar merhaba.
Yeni belgeyi açtım. (yine ben anlamamış olabilirim belki ama)
-- İstediğiniz tam olarak nedir?
-- Hangi sütun hangi sütun ile ya da hangi satır hangi satır ile karşılaştırılacak,
-- Eşitse ne olacak, biri büyükse ne olacak, büyük olanı mı renklendirmek istiyorsunuz, küçük olanı mı?
-- Yani hangi durumda (sütun adı satır numarası belirtirseniz daha iyi anlaşılacak tabi) renklendirme istiyorsunuz?
Elbette yoğun veri içeren bir dosyanız olduğuna göre makro ile çözüm aramanızda yarar var.
Zira mevcut haliyle 170 bin küsur satırlık belge ile çalışmak zor olur, koşullu biçimlendirme de ayrıca yük getirecektir.
 
Son düzenleme:
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Tekrar merhaba.
Yeni belgeyi açtım. (yine ben anlamamış olabilirim belki ama)
-- İstediğiniz tam olarak nedir?
-- Hangi sütun hangi sütun ile ya da hangi satır hangi satır ile karşılaştırılacak,
-- Eşitse ne olacak, biri büyükse ne olacak, büyük olanı mı renklendirmek istiyorsunuz, küçük olanı mı?
-- Yani hangi durumda (sütun adı satır numarası belirtirseniz daha iyi anlaşılacak tabi) renklendirme istiyorsunuz?
Elbette yoğun veri içeren bir dosyanız olduğuna göre makro ile çözüm aramanızda yarar var.
Zira mevcut haliyle 170 bin küsur satırlık belge ile çalışmak zor olur, koşullu biçimlendirme de ayrıca yük getirecektir.
Hocam size şöyle anlatayım. Örnekteki E sütünundaki skor I,J,K,R,S,T,U,V,Y,Z,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ sütunlarını, G sütunundaki skor ise L,M,N,W,X,AI,AJ,AK,AL,AM,AN,AO,AP,AQ sütunlarını ilgilendiriyor.

Örnekteki skora göre MS 0, İY 0, 1.5 alt, 2.5 alt,3.5 alt , tg 0-1 , İY 0/MS 0 sütunlarını içeren sütunların renklendirilmesi gerekiyor.
 

Ö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.
İddia olayını hiç bilmiyorum ve ilgilenmedim, tabi sizin ilgilendiğiniz konu olduğu için hemen görüyorsunuzdur. Benim tablodan tek anladığım ilk yarı ve maç sonucunun 0-0 olduğu. Diğer sütunları gerçekten bilemiyorum, sütun başlıklarındaki harflerden dolayı anlamlandırmaya çalışıyorum o kadar.
Şöyle bir ricam olsa;
-- ilk yarı 0-0 maç sonucu 0-0
-- ilk yarı 0-1 maç sonucu 0-1
-- ilk yarı 1-0 maç sonucu 1-0
-- ilk yarı 1-1 maç sonucu 1-1
-- ilk yarı 1-0 maç sonucu 1-2
.......gibi
farklı sonuçları içerecek şekilde örnek satırlar ekleseniz ve bu satırlardaki skor durumlarına göre, sonuçta görmek istediğiniz renklendirmeyi elle yaparak dosyayı yenilerseniz daha iyi anlayacağım sanırım.
Anlamalıyım ki formüle edebileyim.
 
Son düzenleme:
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
İddia olayını hiç bilmiyorum ve ilgilenmedim, tabi sizin ilgilendiğiniz konu olduğu için hemen görüyorsunuzdur. Benim tablodan tek anladığım ilk yarı ve maç sonucunun 0-0 olduğu. Diğer sütunları gerçekten bilemiyorum, sütun başlıklarındaki harflerden dolayı anlamlandırmaya çalışıyorum o kadar.
Şöyle bir ricam olsa;
-- ilk yarı 0-0 maç sonucu 0-0
-- ilk yarı 0-1 maç sonucu 0-1
-- ilk yarı 1-0 maç sonucu 1-0
-- ilk yarı 1-1 maç sonucu 1-1
-- ilk yarı 1-0 maç sonucu 1-2
.......gibi
farklı sonuçları içerecek şekilde örnek satırlar ekleseniz ve bu satırlardaki skor durumlarına göre, sonuçta görmek istediğiniz renklendirmeyi elle yaparak dosyayı yenilerseniz daha iyi anlayacağım sanırım.
Anlamalıyım ki formüle edebileyim.
Dosya hazır..

http://s3.dosya.tc/server5/2e9aze/ornekrenkli.xlsx.html
 

Ö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.
Merhabalar, iyi bayramlar.
İddaa olayını bilmeyince kısaltmaların anlamını da bilemiyorum doğal olarak.
Ekteki belgede karşılarına kısaca yazabilir misiniz?

Belge burada.
.
 

Ekli dosyalar

Son düzenleme:
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Merhabalar, iyi bayramlar.
İddaa olayını bilmeyince kısaltmaların anlamını da bilemiyorum doğal olarak.
Ekteki belgede karşılarına kısaca yazabilir misiniz?
İyi bayramlar hocam..
Hocam eki indiremiyorum bi siteden yükleyip link atabilir misiniz ?
 

Ö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.
Yukarıdaki cevaba belge bağlantısı ekledim.
 

Ö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.
Şimdi anlaşılır oldu.
Gece geç vakit dosyanızı kuvvetle muhtemel gönderirim.
Şimdi bayramlaşma için bilgisayar başından kalkmam gerek.
İyi bayramlar.
 

Ö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.
Merhaba.
Gerçek belgenizde filtre varsa onu kaldırıp aşağıdaki kod'u sayfanın kod bölümüne veya bir Modül'e yapıştırın.
(Alt tarafta sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLE'yi seçtiğinizde açılan ekranda sağ taraftaki boş alana yapıştırabilirsiniz.)

Ardından sayfaya bir düğme veya şekil ekleyin, bu şekle fareyle sağ tıklayıp "MAKRO ATA"yı seçin ve açılan ekranda BOYA adlı makroyu seçip TAMAM diyerek işlemi tamamlayın.

H1 hücresine, aşağıda yer alan resimdeki şekilde koşullu biçimlendirme uygulayın.

(Yalnızca şunu içeren hücreleri biçimlendir - > Hücre değeri -> Eşit -> = "İŞLEM YAPILIRKEN BEKLEYİN" -> KIRMIZI gibi dikkat çekici bir renk seçin)

Bu düğmeye fareyle tıklayın ve işlem tamamlanıncaya kadar bekleyin.
Boyama sonuçlarını kontrol ederek geri bildirimde bulunursunuz.
.

Kod:
Sub BOYA()
son = [A1000000].End(3).Row
Range("I2:AQ" & son).Interior.Pattern = xlNone
Range("H1") = "İŞLEM YAPILIRKEN BEKLEYİN"
Application.Wait (Now + TimeValue("0:00:01"))
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Zaman = Timer
    For i = 2 To [A1000000].End(3).Row
        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 [A1000000].End(3).Row
        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
                If Trim(1) = Trim(2) Then
                    Cells(i, 10).Interior.ColorIndex = 4
                End If
        End If
    Next i
With Range("AV2:AV" & son)
    .Formula = "=IF(E2=""v"","""",""x"")"
    .Value = .Value
End With

    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 10
If Cells(i, 46) > Cells(i, 47) Then
    Cells(i, 9).Interior.ColorIndex = 4
ElseIf Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 10).Interior.ColorIndex = 4
ElseIf Cells(i, 46) < Cells(i, 47) Then
    Cells(i, 11).Interior.ColorIndex = 4
End If
10
    Next

    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 20
If Cells(i, 44) > Cells(i, 45) Then
    Cells(i, 12).Interior.ColorIndex = 4
ElseIf Cells(i, 44) = Cells(i, 45) Then
    Cells(i, 13).Interior.ColorIndex = 4
ElseIf Cells(i, 44) < Cells(i, 45) Then
    Cells(i, 14).Interior.ColorIndex = 4
End If
20
    Next

    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 30
If Cells(i, 46) > Cells(i, 47) Or Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 18).Interior.ColorIndex = 4
ElseIf Cells(i, 46) > Cells(i, 47) Or Cells(i, 46) < Cells(i, 47) Then
    Cells(i, 19).Interior.ColorIndex = 4
ElseIf Cells(i, 46) < Cells(i, 47) Or Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 20).Interior.ColorIndex = 4
End If
30
    Next

    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 40
If Cells(i, 46) > 0 And Cells(i, 47) = 0 Then
    Cells(i, 21).Interior.ColorIndex = 4
ElseIf Cells(i, 46) = 0 And Cells(i, 47) > 0 Then
    Cells(i, 21).Interior.ColorIndex = 4
ElseIf Cells(i, 46) > 0 And Cells(i, 47) > 0 Then
    Cells(i, 22).Interior.ColorIndex = 4
End If
40
    Next
    
    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 50
If Cells(i, 44) + Cells(i, 45) <= 1 Then
    Cells(i, 23).Interior.ColorIndex = 4
ElseIf Cells(i, 44) + Cells(i, 45) >= 2 Then
    Cells(i, 24).Interior.ColorIndex = 4
End If
50
    Next
    
    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 60
If Cells(i, 46) + Cells(i, 47) < 2 Then
    Cells(i, 25).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) > 2 Then
    Cells(i, 26).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) < 3 Then
    Cells(i, 27).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) > 3 Then
    Cells(i, 28).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) < 4 Then
    Cells(i, 29).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) > 3 Then
    Cells(i, 30).Interior.ColorIndex = 4
End If
60
    Next
   
    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 70
If Cells(i, 46) + Cells(i, 47) < 2 Then
    Cells(i, 31).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) = 2 Or Cells(i, 46) + Cells(i, 47) = 3 Then
    Cells(i, 32).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) > 3 And Cells(i, 46) + Cells(i, 47) < 7 Then
    Cells(i, 33).Interior.ColorIndex = 4
ElseIf Cells(i, 46) + Cells(i, 47) > 6 Then
    Cells(i, 34).Interior.ColorIndex = 4
End If
70
    Next
    
    For i = 2 To [A1000000].End(3).Row
If Cells(i, 48) = "" Then GoTo 80
If Cells(i, 44) > Cells(i, 45) And Cells(i, 46) > Cells(i, 47) Then
    Cells(i, 35).Interior.ColorIndex = 4
ElseIf Cells(i, 44) = Cells(i, 45) And Cells(i, 46) > Cells(i, 47) Then
    Cells(i, 36).Interior.ColorIndex = 4
ElseIf Cells(i, 44) < Cells(i, 45) And Cells(i, 46) > Cells(i, 47) Then
    Cells(i, 37).Interior.ColorIndex = 4
ElseIf Cells(i, 44) > Cells(i, 45) < 3 And Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 38).Interior.ColorIndex = 4
ElseIf Cells(i, 44) = Cells(i, 45) And Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 39).Interior.ColorIndex = 4
ElseIf Cells(i, 44) < Cells(i, 45) And Cells(i, 46) = Cells(i, 47) Then
    Cells(i, 40).Interior.ColorIndex = 4
ElseIf Cells(i, 44) > Cells(i, 45) And Cells(i, 46) < Cells(i, 47) Then
    Cells(i, 41).Interior.ColorIndex = 4
ElseIf Cells(i, 44) = Cells(i, 45) And Cells(i, 46) < Cells(i, 47) Then
    Cells(i, 42).Interior.ColorIndex = 4
ElseIf Cells(i, 44) < Cells(i, 45) And Cells(i, 46) < Cells(i, 47) Then
    Cells(i, 43).Interior.ColorIndex = 4
End If
80
    Next
    Columns("AR:AV").Delete Shift:=xlToLeft

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("H1") = "Lig"

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

End Sub
 

Ekli dosyalar

Son düzenleme:

Ö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.
Merhaba.
Asıl belgenizde, bir önceki cevabımdaki kod yerine aşağıdakini dener misiniz?
Hız bakımından fark ne olacak bakalım?
NOT: Koddaki maç sonucu sütununda v harfi olanlar işleme tabi tutulmaz;
-- 44 sayıları ilk yarı ev sahibi takım gol sayısını,
-- 45 sayıları ilk yarı misafir takım gol sayısını,
-- 46 sayıları maç sonu ev sahibi takım gol sayısını,
-- 44 sayıları maç sonu misafir takım gol sayısını
göstermektedir.
Uygulama sonucunu konu sayfasına yazmanızı rica ediyorum.
Kod:
Sub YENİ()
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

For a = 2 To son
If Cells(a, 5) = "v" Then GoTo 10
    If Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 9).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 10).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 11).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 44) > Cells(a, 45) Then
        Cells(a, 12).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) Then
        Cells(a, 13).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) Then
        Cells(a, 14).Interior.ColorIndex = 4
    End If

    If Cells(a, 48) = 1 Or Cells(a, 49) = 1 Then
        Cells(a, 18).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 48) = 1 Or Cells(a, 50) = 1 Then
        Cells(a, 19).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 49) = 1 Or Cells(a, 50) = 1 Then
        Cells(a, 20).Interior.ColorIndex = 4
    End If

    If Cells(a, 46) > 0 And Cells(a, 47) = 0 Then
        Cells(a, 21).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) = 0 And Cells(a, 47) > 0 Then
        Cells(a, 22).Interior.ColorIndex = 4
    End If

    If Cells(a, 46) > 0 And Cells(a, 47) > 0 Then
        Cells(a, 23).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 44) + Cells(a, 45) < 2 Then
        Cells(a, 24).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) + Cells(a, 45) > 1 Then
        Cells(a, 25).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) + Cells(a, 45) < 2 Then
        Cells(a, 26).Interior.ColorIndex = 4
    End If
    
    
    
    If Cells(a, 46) + Cells(a, 47) > 2 Then
        Cells(a, 27).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) < 3 Then
        Cells(a, 28).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 46) + Cells(a, 47) > 3 Then
        Cells(a, 29).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) < 4 Then
        Cells(a, 30).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 46) + Cells(a, 47) < 2 Then
        Cells(a, 31).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) = 2 Or Cells(a, 46) + Cells(a, 47) = 3 Then
        Cells(a, 32).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) > 3 And Cells(a, 46) + Cells(a, 47) < 7 Then
        Cells(a, 33).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) > 6 Then
        Cells(a, 34).Interior.ColorIndex = 4
    End If

    If Cells(a, 44) > Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 35).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 36).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 37).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) > Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 38).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 39).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 40).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) > Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 41).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 42).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 43).Interior.ColorIndex = 4
    End If

10
Next
Range("AR:AU").ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("H1") = "LİG"

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

End Sub
 
Katılım
30 Aralık 2013
Mesajlar
14
Excel Vers. ve Dili
2010 - Türkçe
Merhaba.
Asıl belgenizde, bir önceki cevabımdaki kod yerine aşağıdakini dener misiniz?
Hız bakımından fark ne olacak bakalım?
NOT: Koddaki maç sonucu sütununda v harfi olanlar işleme tabi tutulmaz;
-- 44 sayıları ilk yarı ev sahibi takım gol sayısını,
-- 45 sayıları ilk yarı misafir takım gol sayısını,
-- 46 sayıları maç sonu ev sahibi takım gol sayısını,
-- 44 sayıları maç sonu misafir takım gol sayısını
göstermektedir.
Uygulama sonucunu konu sayfasına yazmanızı rica ediyorum.
Kod:
Sub YENİ()
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

For a = 2 To son
If Cells(a, 5) = "v" Then GoTo 10
    If Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 9).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 10).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 11).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 44) > Cells(a, 45) Then
        Cells(a, 12).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) Then
        Cells(a, 13).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) Then
        Cells(a, 14).Interior.ColorIndex = 4
    End If

    If Cells(a, 48) = 1 Or Cells(a, 49) = 1 Then
        Cells(a, 18).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 48) = 1 Or Cells(a, 50) = 1 Then
        Cells(a, 19).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 49) = 1 Or Cells(a, 50) = 1 Then
        Cells(a, 20).Interior.ColorIndex = 4
    End If

    If Cells(a, 46) > 0 And Cells(a, 47) = 0 Then
        Cells(a, 21).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) = 0 And Cells(a, 47) > 0 Then
        Cells(a, 22).Interior.ColorIndex = 4
    End If

    If Cells(a, 46) > 0 And Cells(a, 47) > 0 Then
        Cells(a, 23).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 44) + Cells(a, 45) < 2 Then
        Cells(a, 24).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) + Cells(a, 45) > 1 Then
        Cells(a, 25).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) + Cells(a, 45) < 2 Then
        Cells(a, 26).Interior.ColorIndex = 4
    End If
    
    
    
    If Cells(a, 46) + Cells(a, 47) > 2 Then
        Cells(a, 27).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) < 3 Then
        Cells(a, 28).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 46) + Cells(a, 47) > 3 Then
        Cells(a, 29).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) < 4 Then
        Cells(a, 30).Interior.ColorIndex = 4
    End If
    
    If Cells(a, 46) + Cells(a, 47) < 2 Then
        Cells(a, 31).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) = 2 Or Cells(a, 46) + Cells(a, 47) = 3 Then
        Cells(a, 32).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) > 3 And Cells(a, 46) + Cells(a, 47) < 7 Then
        Cells(a, 33).Interior.ColorIndex = 4
    ElseIf Cells(a, 46) + Cells(a, 47) > 6 Then
        Cells(a, 34).Interior.ColorIndex = 4
    End If

    If Cells(a, 44) > Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 35).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 36).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) > Cells(a, 47) Then
        Cells(a, 37).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) > Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 38).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 39).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) = Cells(a, 47) Then
        Cells(a, 40).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) > Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 41).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) = Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 42).Interior.ColorIndex = 4
    ElseIf Cells(a, 44) < Cells(a, 45) And Cells(a, 46) < Cells(a, 47) Then
        Cells(a, 43).Interior.ColorIndex = 4
    End If

10
Next
Range("AR:AU").ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("H1") = "LİG"

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

End Sub
Süre bakımından soruyorsanız bende farkı olmadı. Tabi bunun bilgisayarın durumuna da bağlamak lazım. Sizde kısa süren işlem bende daha uzun sürüyor.

Bir de geçen kodda 2.5 sütunlarında renklendirme eksiği vardı. Şimdikilerde KG sütunlarında eksik var, çifte şans sütunları renksiz. Çözülüyorsa ben kendim nasıl çözebilirim ?
 
Üst