Soru Analiz Formül Revize

dengeceteris

Altın Üye
Katılım
21 Aralık 2019
Mesajlar
206
Excel Vers. ve Dili
Office 2016
Altın Üyelik Bitiş Tarihi
15-06-2025
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 & ":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, ",", "."))


End If
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.EnableEvents = True
End With
End Sub
 
Katılım
6 Mart 2024
Mesajlar
248
Excel Vers. ve Dili
Excel 2010 TR & Excel 2016 TR
Merhaba,
Bu satırın hemen altına
Sa.Cells(i, "D") = Evaluate(Replace(f1, ",", "."))

Bu kodları ekleyerek test ediniz, belki çözüm olur.
C++:
' 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.
 
Son düzenleme:

dengeceteris

Altın Üye
Katılım
21 Aralık 2019
Mesajlar
206
Excel Vers. ve Dili
Office 2016
Altın Üyelik Bitiş Tarihi
15-06-2025
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
 
Katılım
6 Mart 2024
Mesajlar
248
Excel Vers. ve Dili
Excel 2010 TR & Excel 2016 TR
Kodlarınızı test edemediğimden dolayı emin olmamakla birlikte
C++:
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

Altın Üye
Katılım
21 Aralık 2019
Mesajlar
206
Excel Vers. ve Dili
Office 2016
Altın Üyelik Bitiş Tarihi
15-06-2025
Üstad muhteşemsin çok tşk ederim. Saygılarımla
 

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,560
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Home Single Language x64 TR
Altın Üyelik Bitiş Tarihi
29-05-2025
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
 
Üst