(Dizi) makrosu ile hücre karşılaştırma

[desıgner1]

Merhabalar, ekli dosyada açıklama yaptım.
Normalinde for döngüsü ile kullandığım makro
çok yavaş kaldığı için; dizi makrosunun da çok
hızlı çalıştığını bildiğim için, bu yardımı istiyorum.
Dizi makrosuna hakim arkadaşların yardımlarını bekliyorum.
İyi çalışmalar.

 

[askm]

Aşağıdaki şekilde bir kaç saniye sürüyor.

Sub askm()
zaman = Timer
For i = 7 To 15
    If WorksheetFunction.CountIf(Range(Cells(8, i), Cells(65000, i)), Cells(4, i)) > 0 Then
        Cells(4, i).Interior.Color = vbBlue
    End If
Next
MsgBox Format(Timer - zaman, "mm:ss")
End Sub

 

[desıgner1]

merhaba;
benim açıklamam yeterli olmamış sanırım.
Yeşil zemindeki veri sarı zeminde var ise
sarı zemindeki veri mavi ile boyanacak.

 

[antonio]

Şöyle bir kod hazırladım. Umarım işinizi görür.

Sub renklendir()
Dim sh As Worksheet, ss As Long, sut As Long

Set sh = Sayfa1
ss = sh.Range("G:O").Find("*", , , , xlByRows, xlPrevious).Row
sut = sh.Range("XX4").End(xlToLeft).Column
For i = 8 To ss
    For d = 7 To sut
        aranan = sh.Cells(4, d).Value
        If sh.Cells(i, d).Value = aranan Then
            sh.Cells(i, d).Interior.ColorIndex = 28
        End If
    Next d
Next i
MsgBox "İşlem tamamlandı", vbInformation, "antonio"
End Sub

 

[Murat OSMA]

Koşullu Biçimlendirme'ye bu formülü girip biçim seçerek de aynı sonuca daha hızlı ulaşabilirsiniz.

[SIZE="2"]=G8=G$4[/SIZE]

 

[desıgner1]

Sayın Antonio; emeğinize sağlık. Maalesef mevcut makro ile aynı sürede işlem yapıyor.
SAyın Murat ; güzel öneri lakin verinin bulunduğu alanda başkaca işlemlerde yapılıyor.
nasıl bir yol izlemeliyim bilemedim.

Başka öneriler var ise lütfen paylaşınız değerli arkadaşlar.

 

[Ziynettin]

Merhaba,

Tablonuzu 366.560 satıra kadar çoğaltarak 17'i saniyede aşağıdaki kod ile alınan sonuç.

Sub renk_ver()
Application.ScreenUpdating = 0
Application.Calculation = xlCalculationManual
Z = TimeValue(Now)
son = Range("G:O").Find("*", , , , xlByRows, xlPrevious).Row
Range("G8:O" & son).Interior.ColorIndex = xlNone
Set k = Range("G4:O" & son)
a = k
For y = 1 To UBound(a, 2)
    aranan = a(1, y)
    For x = 5 To UBound(a)
        If a(x, y) = aranan Then
            k.Cells(x, y).Interior.Color = vbBlue
        End If
    Next x
Next y
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = 1
MsgBox "İşlem süreniz ;  " & CDate(TimeValue(Now) - Z)
End Sub

 

[desıgner1]

Sayın Ziynettin, merhabalar. Öncelikle teşekkür ederim.

Sisteminizi merak ettim doğrusu ben 17 saniyeyi 70.000 de görebildim.

Koda gelir isek. Bu kodu ben 850x 4 yaklaşık olarak 3500 kez çalıştırıyorum.
Halen kullandığım kod ile aralarında fark; eskisi 8 saniye yeni kod 5.6 saniyede işlem yapıyor.

Siz daha iyi biliryor sunuz elbette;

Set k = Range("G4:O" & son)

ben bu satırı

Set k = Range("G4:O4")

şeklinde değiştirdim kod işini yapmadı. Bu satırı da siz en son satıra kadar (dizi) ye almışsınız.
Bundan dolayı sanırım işlem daha uzun sürüyor.
Çünkü daha önceden normal makro ile dizi makrosu arasında bu kadar kısa fark görmemiştim.
Acaba bahsettiğim hususta bir şey yapılabilir mi ?