• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

metin içindeki rakamları sayma toplama

Katılım
18 Nisan 2005
Mesajlar
62
Excel Vers. ve Dili
Office 2010 - Türkçe
a1:b10 aralığındaki hücrelerde metin var bazı hücrelerde hem metin hem rakam var (1 ile 9 arası) ; a1:b10 arasında kaç adet rakam yazılı ve toplamları nelerdir nasıl bulunur
 

Ekli dosyalar

Vba kod editörünü açın (CTRL+11)
İnsert/Modue tıklayıp yeni bir modül ekleyin, aşağıdaki kodu açılan sayfaya kopyalayın.

Kod:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Right(Left(Bak.Value, Sira), 1)
            If IsNumeric(Karakter) Then
                Toplam = Toplam + Karakter
                RakamSay = RakamSay + 1
            End If
        Next
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
End Function

Bu şekilde excele kendi istediğimiz bir formül eklemiş/tanımlamış olduk. Şimdi bu tanımladığımız formülü kullanalım.

Excel dosyasına dönün

Rakam sayısını saymak için

Kod:
=RToplaSay(A1:B10;0)
Formülünü kullanın.

Rakamları toplamak için

Kod:
=RToplaSay(A1:B10;1)
formülünü kullanın.

Formülün Açıklaması
RToplaSay: Formülümüzün ismi.
A1:B10: Hücre aralığımız.
0 ve 1: Eğer 0 yazarsanız Rakamları sayar ğer 1 yazarsanız toplamı alır.

Son olarak dosyanızı farklı kaydedip "Makro içerebilen çalışma kitabı" seçmelisiniz.

Bu formül sadece bu dosyada çalışır başka dosyalarda da çalışmasını isterseniz aynı uygulamayı yapmalısınız.
 
Merhaba.

Alternatif olsun.

Aşağıdaki kod istediğiniz işlemi yapar.
-- Sayfaya bir adet düğme/şekil gibi nesne ekleyin,
-- Alt taraftan ilgili sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılacak VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- Sayfaya eklediğiniz düğmeye/şekile fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda SAYILARı seçerek işlemi onaylayın.
-- Sayfadaki düğmeye/şekile fareyle tıkladığınızda işlem sonuçları ilgili hücrelere (E3 ve E4) yazılır ve bir bilgi mesajjı görüntülenir.
.
Kod:
[B]Sub [COLOR="Red"]SAYILAR[/COLOR]()[/B]
For sat = 1 To 10
    For sut = 1 To 2
        For k = 1 To Len(Cells(sat, sut))
            If IsNumeric(Mid(Cells(sat, sut), k, 1)) Then
                adet = adet + 1
                sayi = sayi + (1 * Mid(Cells(sat, sut), k, 1))
            End If
        Next
    Next
Next
[[B][COLOR="blue"][SIZE="4"]E3[/SIZE][/COLOR][/B]] = adet: [[B][COLOR="Blue"][SIZE="4"]E4[/SIZE][/COLOR][/B]] = sayi
MsgBox "İşlem Tamamlandı." & vbLf & "- Sayı adeti :  " & adet & vbLf & _
    "- Sayıların Toplamı :  " & sayi, vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]
 
her ikinize de çok teşekkürler ikisi de gayet kullanışlı
 
Merhaba,

Yerleşik fonksiyonlarla aşağıdaki dizi formülleri ile yapabilirsiniz.

Toplama için,

Kod:
=TOPLA(EĞERHATA(--PARÇAAL(DEVRİK_DÖNÜŞÜM(A1:A10&B1:B10);SATIR(1:99);1);""))

Saymak için,

Kod:
=TOPLA(--ESAYIYSA(EĞERHATA(--PARÇAAL(DEVRİK_DÖNÜŞÜM(A1:A10&B1:B10);SATIR(1:99);1);"")))

Saymak için,
 
Merhaba,
Formulu uyguladığımızda

şöyle bir şey oluyor. Yani hücre içindeki her bir sayıyı topluyor. Halbuki 11+5 : 16 olması gerekirken 1+1+5:7 olarak topluyor. yardımcı olabilirmisiniz




Sutun A

Sutun B



Talep edilen (Olması gereken)

Satır 1

11 adet 5 kg

7



16​

Satır 2

2516 adet 312 kg

20



2828​
 
Merhaba elimde b sütununda metin içinde rakamlar var (örn: SAYIN **** **** TOPLAMDA 75 TL BORCUNUZ VARDIR.) ben bu rakamları nasıl toplayabilirim ? dalgalikur' un verdiği kodu denediğimde 0 ları toplamıyordu
 
Merhaba elimde b sütununda metin içinde rakamlar var (örn: SAYIN **** **** TOPLAMDA 75 TL BORCUNUZ VARDIR.) ben bu rakamları nasıl toplayabilirim ? dalgalikur' un verdiği kodu denediğimde 0 ları toplamıyordu
Burdaki veriler muhtemelen başka bir yerden alınıyordur, yani kişinin borçları başka bir yerde sayı olarak listelenmiştir. O listeyi baz alsanız daha doğru olmaz mı?

Verileriniz hep .... TOPLAMDA .... TL BORCUNUZ şeklindeyse aşağıdaki formül B1 hücresindeki tutarı almanızı sağlar:

=KIRP(PARÇAAL(B1;BUL("TOPLAMDA";B1)+8;BUL("TL BORCUNUZ";B1)-(BUL("TOPLAMDA";B1)+8)))*1
 
Vba kod editörünü açın (CTRL+11)
İnsert/Modue tıklayıp yeni bir modül ekleyin, aşağıdaki kodu açılan sayfaya kopyalayın.

Kod:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Right(Left(Bak.Value, Sira), 1)
            If IsNumeric(Karakter) Then
                Toplam = Toplam + Karakter
                RakamSay = RakamSay + 1
            End If
        Next
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
End Function

Bu şekilde excele kendi istediğimiz bir formül eklemiş/tanımlamış olduk. Şimdi bu tanımladığımız formülü kullanalım.

Excel dosyasına dönün

Rakam sayısını saymak için

Kod:
=RToplaSay(A1:B10;0)
Formülünü kullanın.

Rakamları toplamak için

Kod:
=RToplaSay(A1:B10;1)
formülünü kullanın.

Formülün Açıklaması
RToplaSay: Formülümüzün ismi.
A1:B10: Hücre aralığımız.
0 ve 1: Eğer 0 yazarsanız Rakamları sayar ğer 1 yazarsanız toplamı alır.

Son olarak dosyanızı farklı kaydedip "Makro içerebilen çalışma kitabı" seçmelisiniz.

Bu formül sadece bu dosyada çalışır başka dosyalarda da çalışmasını isterseniz aynı uygulamayı yapmalısınız.

Bu kod oluyor ama tek tek topluyor yani 75 le 100 ü toplayıp 175 olması gerekiyorken 7+5=12 yapıyor
 
Kodlar aşağıdaki gibi olmalı.
Kullanımı aynı.
C++:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    Dim Basamak As Integer
    Basamak = 1
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Mid(Bak.Value, Sira, Basamak)
            If IsNumeric(Karakter) Then
                For Basamak = 2 To Len(Bak.Value)
                    Karakter = Mid(Bak.Value, Sira, Basamak)
                    If Not IsNumeric(Karakter) Then
                        Karakter = Mid(Bak.Value, Sira, Basamak - 1)
                        Sira = Sira + Basamak
                        Toplam = Toplam + Karakter
                        RakamSay = RakamSay + 1
                        Exit For
                    End If
                Next
            End If
        Next
        Basamak = 1
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
   
End Function
 
Son düzenleme:
Kodlar aşağıdaki gibi olmalı.
Kullanımı aynı.
C++:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    Dim Basamak As Integer
    Basamak = 1
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Mid(Bak.Value, Sira, Basamak)
            If IsNumeric(Karakter) Then
                For Basamak = 2 To Len(Bak.Value)
                    Karakter = Mid(Bak.Value, Sira, Basamak)
                    If Not IsNumeric(Karakter) Then
                        Karakter = Mid(Bak.Value, Sira, Basamak - 1)
                        Sira = Sira + Basamak
                        Toplam = Toplam + Karakter
                        RakamSay = RakamSay + 1
                        Exit For
                    End If
                Next
            End If
        Next
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
    
End Function

Teşekkür ederim iyi çalışmalar
 
Kodlar aşağıdaki gibi olmalı.
Kullanımı aynı.
C++:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    Dim Basamak As Integer
    Basamak = 1
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Mid(Bak.Value, Sira, Basamak)
            If IsNumeric(Karakter) Then
                For Basamak = 2 To Len(Bak.Value)
                    Karakter = Mid(Bak.Value, Sira, Basamak)
                    If Not IsNumeric(Karakter) Then
                        Karakter = Mid(Bak.Value, Sira, Basamak - 1)
                        Sira = Sira + Basamak
                        Toplam = Toplam + Karakter
                        RakamSay = RakamSay + 1
                        Exit For
                    End If
                Next
            End If
        Next
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
  
End Function

Hocam kusura bakmayın tekrardan yazıyorum ama bu formül yanlış topluyor neden olabilir ? alt alta 2 tane satırı topluyor. 3.satırı toplamıyor
 
Alternatif;

"VBScript.RegExp" yöntemiyle metin içindeki rakamlar alınmaktadır.

Kullanım örnekleri;

=K_TOPLA(A1:A100) 'Rakamları toplar.
=K_TOPLA(A1:A100;DOĞRU) 'Rakamları toplar.
=K_TOPLA(A1:A100;1) 'Rakamları toplar.

=K_TOPLA(A1:A100;YANLIŞ) 'Rakamları sayar.
=K_TOPLA(A1:A100;0) 'Rakamları sayar.


C++:
Function K_TOPLA(Alan As Range, Optional Kriter As Boolean = True) As Double
    Dim Veri As Range
    
    Application.Volatile True
    
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Global = True
        .Pattern = "[^\d-,]+"
    
        For Each Veri In Alan
            If IsNumeric(.Replace(Veri, "")) Then
                If Kriter = True Then
                    K_TOPLA = K_TOPLA + .Replace(Veri, "")
                Else
                    K_TOPLA = K_TOPLA + 1
                End If
            End If
        Next
    End With
End Function
 
Vba kod editörünü açın (CTRL+11)
İnsert/Modue tıklayıp yeni bir modül ekleyin, aşağıdaki kodu açılan sayfaya kopyalayın.

Kod:
Function RToplaSay(Alan As Range, ToplaSay As Byte) As Long
    Dim Bak As Range
    Dim Karakter As String
    Dim Sira As Integer
    Dim RakamSay As Long
    Dim Toplam As Long
    For Each Bak In Alan
        Bak.Select
        For Sira = 1 To Len(Bak.Value)
            Karakter = Right(Left(Bak.Value, Sira), 1)
            If IsNumeric(Karakter) Then
                Toplam = Toplam + Karakter
                RakamSay = RakamSay + 1
            End If
        Next
    Next
    If ToplaSay = 0 Then
        RToplaSay = RakamSay
    ElseIf ToplaSay = 1 Then
        RToplaSay = Toplam
    End If
End Function

Bu şekilde excele kendi istediğimiz bir formül eklemiş/tanımlamış olduk. Şimdi bu tanımladığımız formülü kullanalım.

Excel dosyasına dönün

Rakam sayısını saymak için

Kod:
=RToplaSay(A1:B10;0)
Formülünü kullanın.

Rakamları toplamak için

Kod:
=RToplaSay(A1:B10;1)
formülünü kullanın.

Formülün Açıklaması
RToplaSay: Formülümüzün ismi.
A1:B10: Hücre aralığımız.
0 ve 1: Eğer 0 yazarsanız Rakamları sayar ğer 1 yazarsanız toplamı alır.

Son olarak dosyanızı farklı kaydedip "Makro içerebilen çalışma kitabı" seçmelisiniz.

Bu formül sadece bu dosyada çalışır başka dosyalarda da çalışmasını isterseniz aynı uygulamayı yapmalısınız.
Bunda 24 225 gibi iki haneli veya üç haneli rakamları saymıyor
 
Alternatif;

"VBScript.RegExp" yöntemiyle metin içindeki rakamlar alınmaktadır.

Kullanım örnekleri;

=K_TOPLA(A1:A100) 'Rakamları toplar.
=K_TOPLA(A1:A100;DOĞRU) 'Rakamları toplar.
=K_TOPLA(A1:A100;1) 'Rakamları toplar.

=K_TOPLA(A1:A100;YANLIŞ) 'Rakamları sayar.
=K_TOPLA(A1:A100;0) 'Rakamları sayar.


C++:
Function K_TOPLA(Alan As Range, Optional Kriter As Boolean = True) As Double
    Dim Veri As Range
  
    Application.Volatile True
  
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Global = True
        .Pattern = "[^\d-,]+"
  
        For Each Veri In Alan
            If IsNumeric(.Replace(Veri, "")) Then
                If Kriter = True Then
                    K_TOPLA = K_TOPLA + .Replace(Veri, "")
                Else
                    K_TOPLA = K_TOPLA + 1
                End If
            End If
        Next
    End With
End Function
Bunun rica etsem içine hem rakamları toplayan hem de harfleri toplayan şeklinde olur mu.
Çünkü Bu sefer başka yerde F2 veya N2 olarak rakamları toplamada sıkıntı yok ama başka hücrede eğersay ile ne yazık ki harfi almıyor.
 
Örnek dosya paylaşarak yapmak istediğiniz işlemi açıklayınız.
 
AK35 hücresinde çıkması gereken sonuç nedir?
AK36 hücresinde çıkması gereken sonuç nedir?
 
Geri
Üst