Çözüldü Kod yardımı

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
772
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Merhaba;

E2 hücresinde 90,91
F2 hücresinde 0,08
L2 hücresinde TEM1020 yazıyor.

Aşağıdaki kodu çalıştırıyorum. L2 hücresinin dolgu rengi sarı oluyor.
Fakat F2 hücresi 1,01 olsa L2 hücresinin dolgu rengi sarı olmuyor.
Dolgu renginin sarı olması hatalı işlem anlamına geliyor.

Tahminimce alttaki kod değişmeli, F2 hücresinde 0,01 bile yazsa L2 hücresinin dolgu rengi sarı olmasın, yardımcı olabilir misiniz ?

ElseIf Not IsError(Application.Match(EVal, list1020, 0)) And (BVal = 0 Or CVal = 0) Then
ws.Cells(k, "L").Interior.Color = vbYellow


Asıl Kod

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(5)

Dim k As Long
Dim lastRowt As Long
lastRowt = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

For k = 2 To lastRowt
If ws.Cells(k, "J").Value <> "" Then

Dim EVal As String: EVal = Trim(ws.Cells(k, "L").Value)
Dim AVal As Double: AVal = Val(ws.Cells(k, "D").Value)
Dim BVal As Double: BVal = Val(ws.Cells(k, "E").Value)
Dim CVal As Double: CVal = Val(ws.Cells(k, "F").Value)

' Liste tanımları
Dim listAllKDV As Variant, list1020 As Variant, listNoKDV As Variant, listZ As Variant

listAllKDV = Split("AİD,GİYİM1020,TEM1020", ",")
list1020 = Split("BÜR1020,BÜR70301020,ÇEŞ1020,GİYİM1020,HEDEF,TEM1020", ",")

' Koşullar
If Not IsError(Application.Match(EVal, listAllKDV, 0)) And AVal = 0 And BVal = 0 And CVal = 0 Then
ws.Cells(k, "L").Interior.Color = vbYellow

ElseIf Not IsError(Application.Match(EVal, list1020, 0)) And (BVal = 0 Or CVal = 0) Then
ws.Cells(k, "L").Interior.Color = vbYellow

Else
ws.Cells(k, "L").Interior.ColorIndex = xlNone
End If
End If
Next k
 

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,072
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Sorununuz, F2 hücresindeki değer 1,01 olduğunda L2 hücresinin dolgu renginin sarı olmaması gerektiği, ancak mevcut kodda F2 değeri 0 olduğunda L2 hücresinin sarı renge boyanması. Bu durumu düzeltmek için, ElseIf koşulunda BVal = 0 Or CVal = 0 yerine daha sıkı bir kontrol ekleyerek F2 değerinin 0 olup olmadığını kontrol etmeliyiz. Ayrıca, F2'de 0,01 gibi küçük bir değer bile olsa sarı dolgu olmamalı.
 

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,072
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod:
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(5)

Dim k As Long
Dim lastRowt As Long
lastRowt = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

For k = 2 To lastRowt
    If ws.Cells(k, "J").Value <> "" Then

        Dim EVal As String: EVal = Trim(ws.Cells(k, "L").Value)
        Dim AVal As Double: AVal = Val(ws.Cells(k, "D").Value)
        Dim BVal As Double: BVal = Val(ws.Cells(k, "E").Value)
        Dim CVal As Double: CVal = Val(ws.Cells(k, "F").Value)
       
        Dim listAllKDV As Variant, list1020 As Variant
        listAllKDV = Split("AİD,GİYİM1020,TEM1020", ",")
        list1020 = Split("BÜR1020,BÜR70301020,ÇEŞ1020,GİYİM1020,HEDEF,TEM1020", ",")

       
        If Not IsError(Application.Match(EVal, listAllKDV, 0)) And AVal = 0 And BVal = 0 And CVal = 0 Then
            ws.Cells(k, "L").Interior.Color = vbYellow
        ElseIf Not IsError(Application.Match(EVal, list1020, 0)) And BVal = 0 And CVal = 0 Then
            ws.Cells(k, "L").Interior.Color = vbYellow
        Else
            ws.Cells(k, "L").Interior.ColorIndex = xlNone
        End If
    End If
Next k
Durum 1: E2 = 90,91, F2 = 0,08, L2 = TEM1020
Sonuç: L2 sarı olmaz, çünkü CVal (F2) sıfır değil (0,08).

Durum 2: E2 = 90,91, F2 = 1,01, L2 = TEM1020
Sonuç: L2 sarı olmaz, çünkü CVal (F2) sıfır değil (1,01).

Durum 3: E2 = 0, F2 = 0, L2 = TEM1020
Sonuç: L2 sarı olur, çünkü BVal ve CVal sıfır.

Kodunuzda listNoKDV ve listZ tanımlanmış ancak kullanılmamış. Eğer bu listeler başka bir yerde kullanılmıyorsa, kodun sadeleştirilmesi için kaldırılabilir. Val fonksiyonu yerine CDbl kullanarak sayısal dönüşümü daha güvenli hale getirebilirsiniz, özellikle bölgesel ayarlarla ilgili sorunları önlemek için:

Dim AVal As Double: AVal = CDbl(ws.Cells(k, "D").Value)
Dim BVal As Double: BVal = CDbl(ws.Cells(k, "E").Value)
Dim CVal As Double: CVal = CDbl(ws.Cells(k, "F").Value)
 

cavanoos

Altın Üye
Katılım
17 Aralık 2008
Mesajlar
772
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
11-01-2026
Üstadım;

Dim BVal As Double: BVal = Val(ws.Cells(k, "E").Value)

Yerine

Dim BVal As Double: BVal = CDbl(ws.Cells(k, "E").Value)

sorun çözüldü, emeğine sağlık :)
 
Üst