• Merhaba Ziyaretçi.
    "Yapay Zeka Objektif " Fotoğraf Yarışması başladı. İlgili konuya  BURADAN  ulaşabilirsiniz. Sizi de bu yarışmada görmek isteriz...

Yardım edebilecek varsa Mutlu olacam!

xhreons

Üyecik
İyi günler Benimde bir sorum olcak.Excel tablomuz 5 Sütun 250 satırdan oluşuyor ve hepsinin içinde rakamlar mevcut.Örnek olarak vermek gerekirse misal
Kod:
     A       B       C        D        E
1- 34     35      31         42        24
2- 24     42      52         11        12
3- 23     11      12         34        42
4- 31     42      12        8         7
5- 12      8        7       21       13

Bu şekilde rastgele verilmiş sayılarda misal A1 de 34 D3 te tekrar edilmiş ikisinin rengi misal kahverengi olcak.Yada D1 de 42 B2 de de tekrar edilmiş aynı şekilde olcak.Ek olarakta misal C4-D4-E4 3lüsünün aynısı A%-B5-C5 te de tekrar edilmiş bunların 3 üde aynı sekilde misal mavi olcak yada D2-E2 ikisinin aynısı B3-C3 te tekrar edilmiş bunlarda boyanacak.Yanlız misal D210-E210 da da bu ikili tekrar edilmiş olabilir.Bunlarda boyanacak.Bu işlem bütün belgeye uygulancak bunu çözebilirmisiniz acaba çok kafa yordum ama çıkamadım işin içinden simdiden kolay gelsin

Not : Renkler önemli değil sadece boyansın.
 

CAYİT

Katılımcı
Aşagıdakı kodu deneyebilirsin


Option Explicit

Sub KOŞULLU_RENKLENDİR()
Dim SAYFA As Worksheet
Dim X As Long
Dim BUL1 As Range, BUL2 As Range

For Each SAYFA In Worksheets
If SAYFA.Name <> "Table" Then
SAYFA.Range("C11:BU75").Interior.ColorIndex = xlNone
End If
Next

Sheets("Table").Select

For X = 2 To [I65536].End(3).Row
With Sheets("SET " & Cells(X, "I"))
Set BUL1 = .Range("C11:BU75").Find(Cells(X, "J"), LookAt:=xlWhole)
If Not BUL1 Is Nothing Then
Set BUL2 = .Range(.Cells(76, BUL1.Column), .Cells(76, BUL1.Column + 7)).Find(Cells(X, "K"), LookAt:=xlWhole)
If Not BUL2 Is Nothing Then
.Range(.Cells(BUL1.Row, BUL2.Column), .Cells(BUL1.Row + .Cells(77, BUL2.Column), BUL2.Column)).Interior.ColorIndex = 3
End If
End If
End With
Next

Set BUL1 = Nothing
Set BUL2 = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Top