tek-çift sayıların rakamları toplamı

[kantincatiskilari]

selamlar. excel kullanmayı pek bilmiyorum, çalışmam için tek-çift sayıların rakamları toplamını bana verecek formül gerekli.

örneğin:

15 sayısı tek. 1+5
18 sayısı çift. 1+8 gibi ama bunlar ayrı ayrı lazım. bu konuda bana yardımcı olursanız sevinirim.

 

[Orion1]

Veriler A sütununda.

Sub cifttek_59()
Dim sonsat As Long, i As Long, cift As Long, tek As Long
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To sonsat
    If i Mod 2 = 0 Then cift = cift + Cells(i, "A").Value
    If i Mod 2 <> 0 Then tek = tek + Cells(i, "A").Value
Next
MsgBox "tek : " & tek & vbLf & "Çift : " & cift
End Sub

 

[kantincatiskilari]

Veriler A sütununda.

Sub cifttek_59()
Dim sonsat As Long, i As Long, cift As Long, tek As Long
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To sonsat
    If i Mod 2 = 0 Then cift = cift + Cells(i, "A").Value
    If i Mod 2 <> 0 Then tek = tek + Cells(i, "A").Value
Next
MsgBox "tek : " & tek & vbLf & "Çift : " & cift
End Sub

hocam bana c6-d17 arası veriler için lazım bu kod sadece a sütunu için mi çalışıyor?

 

[Orion1]

hocam bana c6-d17 arası veriler için lazım bu kod sadece a sütunu için mi çalışıyor?

Buyurun.

Sub cifttek_59()
Dim cift As Long, tek As Long, hcr As Range
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For Each hcr In Range("c6:d17")
    If hcr.Value = "" Then GoTo atla
        If hcr.Value Mod 2 = 0 Then cift = cift + hcr.Value
        If hcr.Value Mod 2 <> 0 Then tek = tek + hcr.Value
atla:
Next
MsgBox "tek : " & tek & vbLf & "Çift : " & cift
End Sub

 

[kantincatiskilari]

Buyurun.

Sub cifttek_59()
Dim cift As Long, tek As Long, hcr As Range
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For Each hcr In Range("c6:d17")
    If hcr.Value = "" Then GoTo atla
        If hcr.Value Mod 2 = 0 Then cift = cift + hcr.Value
        If hcr.Value Mod 2 <> 0 Then tek = tek + hcr.Value
atla:
Next
MsgBox "tek : " & tek & vbLf & "Çift : " & cift
End Sub

çok teşekkür ederim bide nasıl çalıştıracağımı söylerseniz rica etsem

 

[kantincatiskilari]

hocam çalıştırdım sağolun. ama burada sadece tek ve çift sayıların toplamını veriyor halbuki bana ondalık olarak toplamları lazım. yani 15 + 5 değil 1+5+5

 

[Korhan Ayhan]

Alternatif olarak aşağıdaki kullanıcı tanımlı fonksiyonu kullanabilirsiniz.

Hücrede kullanım şekli;

=BASAMAK_TOPLA(C6:D17;0) 'Tek sayıların basamaklarını toplar.
=BASAMAK_TOPLA(C6:D17;1) 'Çift sayıların basamaklarını toplar.
=BASAMAK_TOPLA(C6:D17) 'Çift sayıların basamaklarını toplar.

Option Explicit

Function BASAMAK_TOPLA(Alan As Range, Optional Kriter As Boolean = True)
    Dim Veri As Range, X As Byte, Topla_A As Long, Topla_B As Long
   
    Application.Volatile True
   
    For Each Veri In Alan
        If Veri.Value Mod 2 = 0 Then
            For X = 1 To Len(Veri.Value)
                Topla_A = Topla_A + Mid(Veri.Value, X, 1)
            Next
        Else
            For X = 1 To Len(Veri.Value)
                Topla_B = Topla_B + Mid(Veri.Value, X, 1)
            Next
        End If
    Next
   
    BASAMAK_TOPLA = IIf(Kriter = True, Topla_A, Topla_B)
End Function

 

[kantincatiskilari]

Alternatif olarak aşağıdaki kullanıcı tanımlı fonksiyonu kullanabilirsiniz.

Hücrede kullanım şekli;

=BASAMAK_TOPLA(C6:D17;0) 'Tek sayıların basamaklarını toplar.
=BASAMAK_TOPLA(C6:D17;1) 'Çift sayıların basamaklarını toplar.
=BASAMAK_TOPLA(C6:D17) 'Çift sayıların basamaklarını toplar.

Option Explicit

Function BASAMAK_TOPLA(Alan As Range, Optional Kriter As Boolean = True)
    Dim Veri As Range, X As Byte, Topla_A As Long, Topla_B As Long
  
    Application.Volatile True
  
    For Each Veri In Alan
        If Veri.Value Mod 2 = 0 Then
            For X = 1 To Len(Veri.Value)
                Topla_A = Topla_A + Mid(Veri.Value, X, 1)
            Next
        Else
            For X = 1 To Len(Veri.Value)
                Topla_B = Topla_B + Mid(Veri.Value, X, 1)
            Next
        End If
    Next
  
    BASAMAK_TOPLA = IIf(Kriter = True, Topla_A, Topla_B)
End Function

Çok, çok sağolun