hücre içerisinde farklı nesneleri toplama?

Emine Şahin · 31 Mart 2012

Merhaba arkadaşlar.
Bir hücre içerisinde birden çok nesne adeetleriyle beraber yazılıyor. Bunların toplamını almak mümkün mü?

Örneğin:
Aşağıdaki resimde D sütünundaki farklı yazılmış nesneler toplamak istiyorum.
Mümkün mü?

HASAN40 · 31 Mart 2012

Merhaba,
Örnek dosya ekleyip yapmak istediğinizi biraz daha açıklar mısınız?
ETOPLA ve TOPLA.ÇARPIM formüllerine bakınız.

Emine Şahin · 31 Mart 2012

HASAN40' Alıntı:
Merhaba,
Örnek dosya ekleyip yapmak istediğinizi biraz daha açıklar mısınız?
ETOPLA ve TOPLA.ÇARPIM formüllerine bakınız.

Merhaba Hasan Bey.
Resim ekledim ama görüntülenmedi sanırım. Dosya ekliyorum.
Kırmızı dolgu verdiğim yerleri toplamak istiyorum.

HASAN40 · 31 Mart 2012

Merhaba Emine Hanım,
Dosyanızda ufak bir değişim yaptım umarım işinize yarar.

Emine Şahin · 31 Mart 2012

HASAN40' Alıntı:
Merhaba Emine Hanım,
Dosyanızda ufak bir değişim yaptım umarım işinize yarar.

Hasan Bey teşekkür ederim. Ancak dosya üzerinde değişiklik yapamıyorum. Çok büyük bir excell dosyası elimde var ve örnekte sunduğum gibi bir listeleme yapılmış. Yani bir hücre içerisine "3elma+4muz+5erik" şeklinde yazılmış. bunun üzerinden işlem yapmak zorundayım. Tabi burada elma armut temsilidir...

Saygılarımla.

HASAN40 · 31 Mart 2012

Merhaba Emine Hanım,

İsteğiniz benim bilgilerimi aşıyor maalsef

Metin parçalama ve saydırma gibi birşey istiyorsunuz. Çeşitli denemeler yapıyorum ancak sonuca ulaşamadım. Cevabını ben de merakla bekliyorum, inşALLAH uzman arkadaşlarımız sonuca ulaşacaklardır.

Saygılarımla...

Emine Şahin · 31 Mart 2012

Evet, iafade ettiğiniz gibi "Metin parçalama ve saydırma gibi birşey"
Mümkün olabileceğini düşünüyorum. Aradım bulamadım henüz. İnşallah bir cevap çıkar...

Korhan Ayhan · 31 Mart 2012

Merhaba,

Formüllerle çözümü varmı bilemiyorum ama benim aklıma hemen bir kullanıcı tanımlı fonksiyon tasarlamak geldi.

Aşağıdaki kodu boş bir modüle yerleştirin.

Kod:

Function AYIR_TOPLA(Veri As Range, Kriter As Range)
    Dim Hücre As Range, Data As Variant
    Dim X As Integer, Y As Byte
    Dim Yeni_Data As String, Sayı As Long
    
    For Each Hücre In Veri
        Data = Split(Hücre.Text, "+")
        For X = 0 To UBound(Data)
            Yeni_Data = ""
            For Y = 0 To 9
                If Yeni_Data = "" Then
                    Yeni_Data = Replace(Data(X), Y, "")
                Else
                    Yeni_Data = Replace(Yeni_Data, Y, "")
                End If
            Next
        
            If Trim(Yeni_Data) = Kriter Then
                Sayı = Replace(Data(X), Kriter, "")
                AYIR_TOPLA = AYIR_TOPLA + Sayı
            End If
        Next
    Next
End Function

Daha sonra G2 hücresine aşağıdaki formülü uygulayıp alt hücrelere sürükleyin.

Kod:

=AYIR_TOPLA($D$2:$D$1000;F2)

Emine Şahin · 1 Nisan 2012

Korhan Ayhan' Alıntı:

Merhaba,

Formüllerle çözümü varmı bilemiyorum ama benim aklıma hemen bir kullanıcı tanımlı fonksiyon tasarlamak geldi.

Aşağıdaki kodu boş bir modüle yerleştirin.

Kod:

Function AYIR_TOPLA(Veri As Range, Kriter As Range)
    Dim Hücre As Range, Data As Variant
    Dim X As Integer, Y As Byte
    Dim Yeni_Data As String, Sayı As Long
    
    For Each Hücre In Veri
        Data = Split(Hücre.Text, "+")
        For X = 0 To UBound(Data)
            Yeni_Data = ""
            For Y = 0 To 9
                If Yeni_Data = "" Then
                    Yeni_Data = Replace(Data(X), Y, "")
                Else
                    Yeni_Data = Replace(Yeni_Data, Y, "")
                End If
            Next
        
            If Trim(Yeni_Data) = Kriter Then
                Sayı = Replace(Data(X), Kriter, "")
                AYIR_TOPLA = AYIR_TOPLA + Sayı
            End If
        Next
    Next
End Function

Daha sonra G2 hücresine aşağıdaki formülü uygulayıp alt hücrelere sürükleyin.

Kod:

=AYIR_TOPLA($D$2:$D$1000;F2)

Teşekkür ederim Korhan Bey. Tam istediğim gibi oldu. Hatalı yazımları bile (boşluk bırakmaksızın) hesaplıyor. Lakin ufak bir sorunum var. Modül oluşturup kodu buraya ekliyorum. Sayfayı kaydedip kapattığımda:

Dosyayı bu özelliklerde kaydetmek için Hayırı tıklatın ve ardından dosya türü listesinde makro özelliği etkinleştirilmiş bir dosya türü seçin.

Diyor. bende kayıt türünden makro içren belge olarak kaydettim. Sanırım bundan sonra sorun olmaz.
Burada bir soru daha sormak istiyorum. =AYIR_TOPLA($D$2:$D$1000;F2) bu kodu başka bir sayfada işlev görmesini istiyorum. Başka bir sayfada satılanlar gibi yani, böyle bir şey mümkün mü?

Korhan Ayhan · 2 Nisan 2012

Merhaba,

Uygulamayı doğru yapmışsınız. Bundan sonra bir sorun yaşamazsınız. Fonksiyon sayfalar arasıda çalışmaktadır.

Ayrıca verdiğim fonksiyonu boş bir excel kitabında boş bir modüle uyguladıktan sonra dosyayı eklenti olarak kayıt ederseniz tüm excel dosyalarınızda da kullanabilirsiniz.

Eklenti haline getirmek için aşağıdaki linkten faydalanabilirsiniz.

Office 2007 Eklenti Dosyası Oluşturmak (Resimli Anlatım)

Emine Şahin · 4 Nisan 2012

Korhan Ayhan' Alıntı:
Merhaba,

Uygulamayı doğru yapmışsınız. Bundan sonra bir sorun yaşamazsınız. Fonksiyon sayfalar arasıda çalışmaktadır.

Ayrıca verdiğim fonksiyonu boş bir excel kitabında boş bir modüle uyguladıktan sonra dosyayı eklenti olarak kayıt ederseniz tüm excel dosyalarınızda da kullanabilirsiniz.

Eklenti haline getirmek için aşağıdaki linkten faydalanabilirsiniz.

Office 2007 Eklenti Dosyası Oluşturmak (Resimli Anlatım)

Elleriniz dert görmesin Korhan Bey. Eklenti konusu da çok harika. Daha çok şey öğreneceğiz anlaşılan. Ancak bir küçük sorunum var. Ben ekte gönderdiğim dosya örnek bir dosya idi. Dolayısı ile işlem yaptığım nesneler elma armut değil. Nesne adlarında rakamsal ifadeler olanlar var. Örneğin "E1" ya da "D1" gibi... Bunların hesaplanması maalesef olmuyor. Formülden midir yoksa modüle yerleştirdiğimizden kodlardan mıdır bilemiyorum. Bir çözüm mümkün mü acaba?

Korhan Ayhan · 4 Nisan 2012

Merhaba,

Verdiğiniz örnekte değerler arasında "+" sembolü vardı. Formülü tasarlarken bunu dikkate almıştım. Farklı şekillerde verileriniz varsa olumlu sonuç alamayabilirsiniz. Net sonuç için farklı veriler içeren küçük bir örnek dosya eklerseniz yazacağımız fonksiyonu deneme şansımız olabilir.

Emine Şahin · 4 Nisan 2012

Korhan Ayhan' Alıntı:
Merhaba,

Verdiğiniz örnekte değerler arasında "+" sembolü vardı. Formülü tasarlarken bunu dikkate almıştım. Farklı şekillerde verileriniz varsa olumlu sonuç alamayabilirsiniz. Net sonuç için farklı veriler içeren küçük bir örnek dosya eklerseniz yazacağımız fonksiyonu deneme şansımız olabilir.

Örnek dosyayı ekledim. değerler arasında "+" sembolünü kullanıyorum. Bazı verileri kaldırdım ama sonuca etki edecek değil. Siz bakınca anlarsınız zaten...

Korhan Ayhan · 5 Nisan 2012

Merhaba,

Aşağıdaki fonksiyonu deneyiniz.

Kod:

Function AYIR_TOPLA(Veri As Range, Kriter As Range)
    Dim Hücre As Range
    Dim Data_1 As String, Data_2 As Variant
    Dim X As Integer, Y As Integer
    Dim Yeni_Data As String, Sayı As Long
    
    Application.Volatile True
    
    If Kriter = "" Then Exit Function
    
    For Each Hücre In Veri
        Data_1 = Trim(Replace(Hücre.Text, " ", ""))
        If InStr(1, Data_1, "+") = 0 Then
            If InStr(1, Data_1, Kriter) > 0 Then
                AYIR_TOPLA = AYIR_TOPLA + Val(Trim(Replace(Data_1, Kriter, "")))
            End If
        Else
            Data_2 = Split(Data_1, "+")
            For X = 0 To UBound(Data_2)
                Yeni_Data = ""
                For Y = 1 To Len(Data_2(X))
                    If Yeni_Data = "" Then
                        Kontrol = Mid(Data_2(X), Y, 1)
                    Else
                        Kontrol = Mid(Yeni_Data, Y, 1)
                    End If
                    
                    If IsNumeric(Kontrol) Then
                        Yeni_Data = Mid(Data_2(X), Y + 1, 1024)
                        Y = 0
                    Else
                        GoTo 10
                    End If
                Next
            
10              If Trim(Yeni_Data) = Kriter Then
                    Sayı = Replace(Data_2(X), Kriter, "")
                    AYIR_TOPLA = AYIR_TOPLA + Sayı
                End If
            Next
        End If
    Next
End Function

tahsinanarat · 5 Nisan 2012

Elinize sağlık Korhan hocam, bende sonucunu merakla bekleyenlerdendim. Meğerse elma ile armut da toplanırmış

Emine Şahin · 6 Nisan 2012

Korhan Ayhan' Alıntı:

Merhaba,

Aşağıdaki fonksiyonu deneyiniz.

Kod:

Function AYIR_TOPLA(Veri As Range, Kriter As Range)
    Dim Hücre As Range
    Dim Data_1 As String, Data_2 As Variant
    Dim X As Integer, Y As Integer
    Dim Yeni_Data As String, Sayı As Long
    
    Application.Volatile True
    
    If Kriter = "" Then Exit Function
    
    For Each Hücre In Veri
        Data_1 = Trim(Replace(Hücre.Text, " ", ""))
        If InStr(1, Data_1, "+") = 0 Then
            If InStr(1, Data_1, Kriter) > 0 Then
                AYIR_TOPLA = AYIR_TOPLA + Val(Trim(Replace(Data_1, Kriter, "")))
            End If
        Else
            Data_2 = Split(Data_1, "+")
            For X = 0 To UBound(Data_2)
                Yeni_Data = ""
                For Y = 1 To Len(Data_2(X))
                    If Yeni_Data = "" Then
                        Kontrol = Mid(Data_2(X), Y, 1)
                    Else
                        Kontrol = Mid(Yeni_Data, Y, 1)
                    End If
                    
                    If IsNumeric(Kontrol) Then
                        Yeni_Data = Mid(Data_2(X), Y + 1, 1024)
                        Y = 0
                    Else
                        GoTo 10
                    End If
                Next
            
10              If Trim(Yeni_Data) = Kriter Then
                    Sayı = Replace(Data_2(X), Kriter, "")
                    AYIR_TOPLA = AYIR_TOPLA + Sayı
                End If
            Next
        End If
    Next
End Function

Elinize sağlık Korhan Bey. ÇAlışıyor. Ancak küçük bir sorun var. "1 E1" Şeklinde yazınca sorun yok. Ama kazara "1E1" bitişik yazınca excel dosyam kaarsız kalıyor ve hesaplama yapmıyor. Dosya kasılıp kalıyor maalesef...

Korhan Ayhan · 7 Nisan 2012

Merhaba,

Ben bahsettiğiniz şekilde de denemiştim. Zaten eklemiş olduğunuz dosyada bahsettiğiniz veriler var ve hesaplamaya dahil oluyor. Sadece büyük-küçük harf ayrımına dikkat edin. Fonksiyonda büyük-küçük harf ayrımı vardır. Eğer derseniz ki "e1" ile "E1" değerleri birbirine eşittir. Bu durumda fonksiyona ekleme yapmak gerekecektir.

Aşağıdaki kodu deneyin.

Kod:

Function AYIR_TOPLA(Veri As Range, Kriter As Range)
    Dim Hücre As Range
    Dim Data_1 As String, Data_2 As Variant
    Dim X As Integer, Y As Integer
    Dim Yeni_Data As String, Sayı As Long
 
    Application.Volatile True
 
    If Kriter = "" Then Exit Function
 
    For Each Hücre In Veri
        Data_1 = Trim(Replace(Hücre.Text, " ", ""))
        If InStr(1, Data_1, "+") = 0 Then
            If InStr(1, Data_1, Kriter) > 0 Then
                AYIR_TOPLA = AYIR_TOPLA + Val(Trim(Replace(Data_1, Kriter, "")))
            End If
        Else
            Data_2 = Split(Data_1, "+")
            For X = 0 To UBound(Data_2)
                Yeni_Data = ""
                For Y = 1 To Len(Data_2(X))
                    If Yeni_Data = "" Then
                        Kontrol = Mid(Data_2(X), Y, 1)
                    Else
                        Kontrol = Mid(Yeni_Data, Y, 1)
                    End If
 
                    If IsNumeric(Kontrol) Then
                        Yeni_Data = Mid(Data_2(X), Y + 1, 1024)
                        Y = 0
                    Else
                        GoTo 10
                    End If
                Next
 
10              If UCase(Replace(Replace(Trim(Yeni_Data), "i", "İ"), "ı", "I")) = _
                    UCase(Replace(Replace(Kriter, "i", "İ"), "ı", "I")) Then
                    Sayı = Replace(Data_2(X), Kriter, "", , , vbTextCompare)
                    AYIR_TOPLA = AYIR_TOPLA + Sayı
                End If
            Next
        End If
    Next
End Function

tahsinanarat · 7 Nisan 2012

Sn. Korhan hocam;
+1e1 yazınca bir artırma yerine mevcut toplamın önüne 1 ekliyor. Yani 4 olan sayı küçük harflerle 1e1 yazıldığında 5 değilde 14 oluyor. Bilgilerinize.

Korhan Ayhan · 7 Nisan 2012

Merhaba,

Uygulamalı çalışan örnek dosya ektedir.

Sarı renkli hücreleri kontrol ediniz.

halit3 · 7 Nisan 2012

Alternatif kod

Kod:

Sub aktar()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sat = 2
Columns("J:N").ClearContents
For r = 2 To Cells(Rows.Count, "g").End(3).Row
AlinacakVeri = "+"
adres = Cells(r, 7).Value
a = InStr(Trim(adres), AlinacakVeri)
t = 0
k = 1
If a > 0 Then
For j = a To Len(adres)
bulunan1 = InStr(j, adres, AlinacakVeri, vbTextCompare)
If bulunan1 > 0 Then
yer = WorksheetFunction.Trim(Mid(adres, k, bulunan1 - k))

If IsNumeric(Mid(yer, 1, 2)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(yer, 3, Len(yer)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(yer, 1, 2))
ElseIf IsNumeric(Mid(yer, 1, 1)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(yer, 2, Len(yer)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(yer, 1, 1))
Else
Cells(sat, "N").Value = yer
End If
sat = sat + 1
j = bulunan1 + 1
k = bulunan1 + 1
t = 1
Else
yer2 = WorksheetFunction.Trim(Mid(adres, k, Len(adres)))
If IsNumeric(Mid(yer2, 1, 2)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(yer2, 3, Len(yer2)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(yer2, 1, 2))
ElseIf IsNumeric(Mid(yer2, 1, 1)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(yer2, 2, Len(yer2)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(yer2, 1, 1))

Else
Cells(sat, "N").Value = yer2
End If
sat = sat + 1
Exit For
End If
Next j
End If
If t = 0 Then

If IsNumeric(Mid(adres, 1, 2)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(adres, 3, Len(adres)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(adres, 1, 2))
ElseIf IsNumeric(Mid(adres, 1, 1)) = True Then
Cells(sat, "N").Value = WorksheetFunction.Trim(Mid(adres, 2, Len(adres)))
Cells(sat, "M").Value = WorksheetFunction.Trim(Mid(adres, 1, 1))

Else
Cells(sat, "N").Value = adres
End If

sat = sat + 1
End If
Next r
Set j = CreateObject("Scripting.Dictionary")
For Each x In [N2:N1000]
If UCase(x.Value) <> "" Then
If Not j.exists(UCase(x.Value)) Then
j.Add UCase(x.Value), Nothing
s = s + 1
Cells(s + 1, "j").Value = UCase(x.Value)
Cells(s + 1, "K").Value = "=COUNTIF(C[3],RC[-1])"
Cells(s + 1, "K").Value = Cells(s + 1, "K").Value
Cells(s + 1, "L").Value = "=SUMIF(C[2],RC[-2],C[1])"
Cells(s + 1, "L").Value = Cells(s + 1, "L").Value
End If
 
End If
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "işlem tamam"
End Sub

hücre içerisinde farklı nesneleri toplama?

Emine Şahin

HASAN40

Emine Şahin

Ekli dosyalar

HASAN40

Ekli dosyalar

Emine Şahin

HASAN40

Emine Şahin

Korhan Ayhan

Administrator

Emine Şahin

Korhan Ayhan

Administrator

Emine Şahin

Korhan Ayhan

Administrator

Emine Şahin

Ekli dosyalar

Korhan Ayhan

Administrator

tahsinanarat

Emine Şahin

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

Ekli dosyalar

halit3

Uzman

Ekli dosyalar