Soru Analiz Formül Revize

[dengeceteris]

Sevgili arkadaşlar bir sorum olacak. Uzun süredir kullandığım ama bir noktada revize ihtiyacı duyduğum bir formülüm var. Zaten yine bu sitede arkadaşlar yazıvermişti. İstediğim ise formülün sonucu: #SAYI/0! veya #DEĞER! geldiği zaman mesela 0'a bölünemez gibi bir durum oluşunca bu hata kodlarını vermeden boş bırakıp farklı bir renge o hücreyi boyasa mümkün mü acaba ?

Sub FİNANSAL_ANALİZ()

Set sV = Sheets("ANAMİZAN")
Set Sa = Sheets("ANALİZ")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

son = Sa.Cells(Rows.Count, 1).End(3).Row
For i = 2 To son
If Sa.Cells(i, 1) <> "" Then
Sa.Range("D" & i & "" & i).ClearContents
End If
Next

liste = sV.Range("BI3:BN" & sV.Cells(Rows.Count, 1).End(3).Row).Value
Dim w(1 To 3)

With CreateObject("Scripting.Dictionary")
For i = LBound(liste) To UBound(liste)
For ii = 1 To 3
al = Val(liste(i, ii))
If .Exists(al) Then
z = .Item(al)
z(1) = z(1) + liste(i, 4)
.Item(al) = z
Else
z = w
z(1) = liste(i, 4)
.Item(al) = z
End If
Next ii
Next i
Sa.Select
son = Sa.Cells(Rows.Count, 1).End(3).Row
For i = 2 To son
Dim col As New Collection
al = Sa.Cells(i, 1)
If al <> "" Then
a = "="
onc_nm = False
For ii = 1 To Len(al)
b = Mid(al, ii, 1)
If IsNumeric(b) Or b = "." Then nm = True Else nm = False
If nm <> onc_nm Then
col.Add a
a = b
Else
a = a & b
End If
onc_nm = nm
Next ii
col.Add a

f1 = ""
f2 = ""
If col.Count > 0 Then
For iii = 1 To col.Count
If IsNumeric(col(1)) And Len(col(1)) < 4 And InStr(col(1), ".") = 0 Then
If .Exists(Val(col(1))) Then
z = .Item(Val(col(1)))
Else
z(1) = 0
z(2) = 0
End If
f1 = f1 & z(1)
Else
f1 = f1 & col(1)
End If
col.Remove 1
Next iii
End If
Sa.Cells(i, "D") = Evaluate(Replace(f1, ",", "."))


End If
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.EnableEvents = True
End With
End Sub

 

[Biolightant]

Merhaba,
Bu satırın hemen altına

Sa.Cells(i, "D") = Evaluate(Replace(f1, ",", "."))

Bu kodları ekleyerek test ediniz, belki çözüm olur.

' Eğer hücrede hata varsa boş bırak ve dolgu rengini değiştir
If Not IsNumeric(Sa.Cells(i, "D")) Then
    Sa.Cells(i, "D").ClearContents ' Hücre içeriğini temizle
    Sa.Cells(i, "D").Interior.Color = 65535 ' Sarı dolgu rengi
End If

Not: Farklı renk istersen Boş bir Excel sayfasında Makro kaydet ile istediğin rengin numarasını bulabilirsin.

 

[dengeceteris]

Sevgili Üstadım geç dönüşüm için kusura bakmayın lütfen.. Ben dediğiniz gibi yaptım ama yapıştırdığım alanın ehemn altından devam eden Next i kısmında duruyor ve ekrana Next Without For diye bir uyarı veriyor

 

[Biolightant]

Kodlarınızı test edemediğimden dolayı emin olmamakla birlikte

Sub FİNANSAL_ANALİZ()

Set sV = Sheets("ANAMİZAN")
Set Sa = Sheets("ANALİZ")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

son = Sa.Cells(Rows.Count, 1).End(3).Row
For i = 2 To son
If Sa.Cells(i, 1) <> "" Then
Sa.Range("D" & i & ":D" & i).ClearContents
End If
Next

liste = sV.Range("BI3:BN" & sV.Cells(Rows.Count, 1).End(3).Row).Value
Dim w(1 To 3)

With CreateObject("Scripting.Dictionary")
For i = LBound(liste) To UBound(liste)
For ii = 1 To 3
al = Val(liste(i, ii))
If .Exists(al) Then
Z = .Item(al)
Z(1) = Z(1) + liste(i, 4)
.Item(al) = Z
Else
Z = w
Z(1) = liste(i, 4)
.Item(al) = Z
End If
Next ii
Next i
Sa.Select
son = Sa.Cells(Rows.Count, 1).End(3).Row
For i = 2 To son
Dim col As New Collection
al = Sa.Cells(i, 1)
If al <> "" Then
a = "="
onc_nm = False
For ii = 1 To Len(al)
b = Mid(al, ii, 1)
If IsNumeric(b) Or b = "." Then nm = True Else nm = False
If nm <> onc_nm Then
col.Add a
a = b
Else
a = a & b
End If
onc_nm = nm
Next ii
col.Add a

f1 = ""
f2 = ""
If col.Count > 0 Then
For iii = 1 To col.Count
If IsNumeric(col(1)) And Len(col(1)) < 4 And InStr(col(1), ".") = 0 Then
If .Exists(Val(col(1))) Then
Z = .Item(Val(col(1)))
Else
Z(1) = 0
Z(2) = 0
End If
f1 = f1 & Z(1)
Else
f1 = f1 & col(1)
End If
col.Remove 1
Next iii
End If
Sa.Cells(i, "D") = Evaluate(Replace(f1, ",", "."))

    '''''''''''''''''''''''''''''''''''''''''
    ' Eğer hücrede hata varsa boş bırak ve dolgu rengini değiştir
    If Not IsNumeric(Sa.Cells(i, "D")) Then
        Sa.Cells(i, "D").ClearContents ' Hücre içeriğini temizle
        Sa.Cells(i, "D").Interior.Color = 65535 ' Sarı dolgu rengi
    End If
    ''''''''''''''''''''''''''''''''''''''''''

End If
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.EnableEvents = True
End With
End Sub

 

[dengeceteris]

Üstad muhteşemsin çok tşk ederim. Saygılarımla

 

[Biolightant]

Üstad muhteşemsin çok tşk ederim. Saygılarımla

Abartmayalım Saygılarımla.

 

[assenucler]

Sayın dengeceteris,

Dosyayı paylaşmanız mümkün mü?


Sn. Biolightant, üstadım da katkıları ve detaylı bilgilendirme ile sitemize renk kattı.

Saygılar,
Selim