Otomatik Renklendirme

[erenkoray]

Merhabalar,

Ben yapay zeka yardımı ile bir macro yazdırdım. Macrodaki ihtiyacım şu elimde çeşitli sayılar var. Örnek; 1 ile 100 arası sayılar 100 satıra yazılı. Burada macro en büyük sayıyı kırmızıya boyuyor. En düşük ve aynı olanların renklerini ellemiyor. Büyük ve düşük sayı arasında kalanları da sarıya boyuyor. Yanlızca şöyle bir sorun var. Bu sayı 100 de olabilir 10 da 1000 de. O yüzden burada macroda formülde en son satırı bulmasını söylemem lazım ama yapay zekaya bir türlü yaptıramadım. Ben formülü paylaşayım daha net anlayacaksınız. Burada I26 da ki değeri bir şekilde kendi bulması gerekiyor. h2 sabit kalacak. Yardımcı olabilirseniz çok mutlu olurum

"

Sub RenkleriBelirle()
    Dim ws As Worksheet
    Dim rng As Range
    Dim maxVal As Double
    Dim minVal As Double
    Dim cellVal As Variant
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet1 sayfasını tanımlayın
    Set rng = ws.Range("H2:I26") 'veri aralığını tanımlayın
    'En yüksek ve en düşük değerleri hesaplayın
    maxVal = WorksheetFunction.Max(rng)
    minVal = WorksheetFunction.Min(rng)
    'Her hücreyi dolaşın ve renklendirin
    For Each cell In rng.Cells
        cellVal = cell.Value
        If IsNumeric(cellVal) Then
            If cellVal < maxVal And cellVal > minVal Then
                'Hücre değeri en yüksek değerden küçük ve en düşük değerden büyükse sarı yap
                cell.Interior.Color = vbYellow
                cell.Offset(0, -1).Interior.Color = vbYellow
            ElseIf cellVal = maxVal Then
                'en büyük değerleri kırmızı yap
                cell.Interior.Color = vbRed
                cell.Offset(0, -1).Interior.Color = vbRed
            ElseIf cellVal = minVal Then
                'en düşük değerleri renksiz yap
                cell.Interior.ColorIndex = xlNone
                cell.Offset(0, -1).Interior.ColorIndex = xlNone
            Else
                'hücreyi renksiz yap
                cell.Interior.ColorIndex = xlNone
                cell.Offset(0, -1).Interior.ColorIndex = xlNone
            End If
        End If
    Next cell
End Sub

"

Şimdiden herkese çok teşekkür ediyorum.

 

[AdemCan]

Merhaba
I sütununa göre son dolu satırı bulmak için Set rng = ws.Range("H2:I26") satırının yerine paylaştığım satırları kullanabilirsiniz.

    son = ws.Range("I" & Rows.Count).End(3).Row
    Set Rng = ws.Range("H2:I" & son) 'veri aralığını tanımlayın

 

[hamitcan]

ws.Range("H2:I26")
yerine
ws.Range("H2:I"& [h65536].end(3).row)
şeklinde kullanın.

 

[hamitcan]

Ben yapay zeka yardımı ile bir macro yazdırdım.

Sayın erenkoray, bir program yardımı ile mi yaptınız, açıklar mısınız ?