Soru Boş Hücreye İşlem Yapmaması

[dengeceteris]

Günaydın.. Uzman arkadaşların yardımıyla bir tablo oluşturdum ama son anda bir problem oluştu çözüm konusunda yardımlarınızı bekliyorum.. Şimdiden tşk ederim.

Bir sayfama Etopla ile önce verileri çekiyorum. Bu veriler içinde bazı hücreler boş oluyor. Bu aşamada bir sorun olmuyor. (Aşağıda ETOPLA başlılı makro) İkinci formülümde aslında düzgün çalışıyor (Sub Renklendir) ama en büyük ilk 30 veriyi renklendirirken her sütüunda değil ama bazı sütunlarda boş hücreleri de renklendiriyor. Boş hücreye herhangi bir renklendirme yapmamasını nasıl sağlayabilirim

Sub ETOPLA()
On Error Resume Next
Range("C7:CW" & Rows.Count).Clear
Dim son As Long
son = Sheets("ANALİZ1").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("ANALİZ1").Range("C7:CW" & son)
.Formula = "=SumIf('HAM-VERİ'!$A:$A,ANALİZ1!$A7,'HAM-VERİ'!C:C)/SumIf('FİRMA ORTALAMA'!$A:$A,ANALİZ1!$A7,'FİRMA ORTALAMA'!C:C)*-1"
.SpecialCells(xlCellTypeFormulas, 16).ClearContents
.Value = .Value
End With
End Sub

Sub Renklendir()
Dim rng As Range, target As Range, lrow As Long, lcol As Integer
topN = 30
lrow = Cells(Rows.Count, 1).End(3).Row
lcol = Cells(6, Columns.Count).End(1).Column
For i = 3 To lcol
Set target = Range(Cells(7, i), Cells(Cells(Rows.Count, 1).End(3).Row, i))
For Each rng In target
For j = 1 To topN
If rng.Value = WorksheetFunction.Large(target, j) Then
rng.Interior.Color = vbGreen
End If
Next j
Next rng
Next i
End Sub

 

[NBATMAN]

rng.Value =

Merhaba,

altta sizin kodunuzdaki kırmızı renkli satırdaki düzenleme yeterli olur düşüncesindeyim. Olmaz ise altta ki renklendirme kod bloğu örneğinide kullanabilirsiniz.

Sub Renklendir()
Dim rng As Range, target As Range, lrow As Long, lcol As Integer
topN = 30
lrow = Cells(Rows.Count, 1).End(3).Row
lcol = Cells(6, Columns.Count).End(1).Column
For i = 3 To lcol
Set target = Range(Cells(7, i), Cells(Cells(Rows.Count, 1).End(3).Row, i))
For Each rng In target
For j = 1 To topN
If rng.Value <>"" And rng.Value = WorksheetFunction.Large(target, j) Then
rng.Interior.Color = vbGreen
End If
Next j
Next rng
Next i
End Sub


Diğer ÖRNEK

Sub Renklendir()
Dim rng As Range, target As Range
Dim lrow As Long, lcol As Integer, topN As Integer
Dim dataArr() As Variant
Dim i As Integer, j As Integer, k As Integer
Dim maxVal As Double, count As Integer

topN = 30
lrow = Cells(Rows.count, 1).End(xlUp).Row
lcol = Cells(6, Columns.count).End(xlToLeft).Column

For i = 3 To lcol
Set target = Range(Cells(7, i), Cells(lrow, i))

' Hücre aralığındaki verileri diziye aktar
dataArr = target.Value

' En büyük değerleri bul ve yeşil renge boyala
For j = 1 To topN
maxVal = -999999 ' varsayılan bir başlangıç değeri seçildi
For k = 1 To UBound(dataArr, 1)
If IsNumeric(dataArr(k, 1)) And dataArr(k, 1) > maxVal Then
maxVal = dataArr(k, 1)
End If
Next k

' En büyük değeri bulduktan sonra, hücreleri yeşil renge boyala
count = 0
For k = 1 To UBound(dataArr, 1)
If (dataArr(k, 1)) <> "" And IsNumeric(dataArr(k, 1)) And dataArr(k, 1) = maxVal Then
Set rng = Cells(k + 6, i)
rng.Interior.Color = vbGreen
count = count + 1
If count = topN Then Exit For ' İstenen en büyük değer sayısına ulaşıldıysa çık
End If
Next k
Next j
Next i
End Sub

 

[dengeceteris]

Sevgili üstadım şimdi formülleri inceleyince sorunu biraz daha anladım. Sorumda yazdığım Sub ETOPLA() formülünde ben bir bölme işlemi yapıyorum. orada ki -+ ile ilgili problemi çözememişim. Ben orayı aşabilirsem başka formüle ihtiyacım kalmayacak. ama yardımınız gerekiyor. Ancak yapılıabilir bir durummudur bilmiyorum gerçekten

En aşağıda yazdığım ETOPLA formülünü revize etmem gerekiyor. Yani sonuçları aşağıda yazdığım 4 formüle ayarlamam gerekiyor.

Eğer(VE(HAMVERİ <0;FİRMAORTALAMA<0); Sonuç -(eksi) karakterli olmalı
Eğer(VE(HAMVERİ >0;FİRMAORTALAMA<0); Sonuç +(artı) karakterli olmalı
Eğer(VE(HAMVERİ >0;FİRMAORTALAMA>0); Sonuç +(artı) karakterli olmalı
Eğer(VE(HAMVERİ <0;FİRMAORTALAMA>0); Sonuç -(eksi) karakterli olmalı

.Formula = "=SumIf('HAM-VERİ'!$A:$A,ANALİZ1!$A7,'HAM-VERİ'!C:C)/SumIf('FİRMA ORTALAMA'!$A:$A,ANALİZ1!$A7,'FİRMA ORTALAMA'!C:C)"

 

[dengeceteris]

Aşağıda yazılı formülü bir türlü revize edemedim. Bölünen ve bölen tarafında - veya + işaretli olanlara göre farklı sonuçlar üretmem lazım. Yardımcı olursanız sevinirim. İstediğim 2 adet sonuç doğru ama diğer iki seçeneği ters getirmek zorundayım biraz matematik kuralına aykırı olarak. Ancak o zaman doğru sonuçlara varabiliyorum.

Sub ETOPLA()
On Error Resume Next
Range("C7:CW" & Rows.count).Clear
Dim son As Long
son = Sheets("ANALİZ1").Cells(Rows.count, 1).End(xlUp).Row
With Sheets("ANALİZ1").Range("C7:CW" & son)
.Formula = "=SumIf('HAM-VERİ'!$A:$A,ANALİZ1!$A7,'HAM-VERİ'!C:C)/SumIf('FİRMA ORTALAMA'!$A:$A,ANALİZ1!$A7,'FİRMA ORTALAMA'!C:C)"
.SpecialCells(xlCellTypeFormulas, 16).ClearContents
.Value = .Value
End With
End Sub

 

[dengeceteris]

Birinin dikkatini çeker umarım