cümlenin son kelimesini kırpma/sütuna dağıtma

[trakonya]

merhaba üstadlar

şu zamana kadar 2 yada 3 kelimeden oluşan isim listelerinde çalışmak için

=EĞER(BAĞ_DEĞ_SAY(BUL(" ";A2;BUL(" ";A2)+1))>0;SOLDAN(A2;BUL(" ";A2;BUL(" ";A2)+1)-1);SOLDAN(A2;BUL(" ";A2)-1))

ve

=PARÇAAL(A2;UZUNLUK(B2)+2;UZUNLUK(A2)-UZUNLUK(B2))

şeklinde bir formül kullanıyordum.

daha çok sayıda kelimeden oluşan metinlerin son kelimesini
başka bir sütuna kırpmam gerekiyor.

yardımlarınızı rica ediyorum

 

[Korhan Ayhan]

Selamlar,

Verinizin A1 hücresinde olduğunu düşünürsek B1 hücresine aşağıdaki dizi formülünü uygulayıp denermisiniz.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;MAK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))+1;255);A1)

 

[trakonya]

Selamlar,

Verinizin A1 hücresinde olduğunu düşünürsek B1 hücresine aşağıdaki dizi formülünü uygulayıp denermisiniz.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;MAK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))+1;255);A1)

Korhan Bey; öncelikle alâkanıza minnettarım.

Verdiğiniz formülü kullandığımda (#DEĞER!) sonucunu alıyorum. acemi bir excel kullanıcısı olarak bu sonucun hücre biçimlendirmesinden kaynaklanabileceğini zannederek birkaç deneme yaptım ancak yine sonuca ulaşamadım.

bir fiyat listesini taratarak excele aktardım. amacım 6.000 küsur satırın boşlukla ayrılmış son kelimesi olan rakamları bir yan sütuna kırpıp, sonrasında filtreleyerek kırpılmış rakamları silip, listenin geri kalanındaki iki sütunu birleştirerek fiyatsız bir fiyat listesi oluşturmak.

örnek vermek gerekirse şimdiki hâli:

portakallı pekin ördeği 75
çin usulü acılı tavuk
patates kızartma 12
su 3
sebzeli makarna

istediğim hâli:

portakallı pekin ördeği
çin usulü acılı tavuk
patates kızartma
su
sebzeli makarna

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki formülü B1 hücresine uygulayın. Cursor hücre içindeyken CTRL+SHIFT+ENTER tuşlarına basarak B1 hücresini terk edin. Bu şekilde formül DİZİ formül haline gelecektir.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;1;MAK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))-1);A1)

Ya da aşağıdaki formülü kullanabilirsiniz.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;1;BÜYÜK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);"");1)-1);A1)

 

[trakonya]

Selamlar,

Aşağıdaki formülü B1 hücresine uygulayın. Cursor hücre içindeyken CTRL+SHIFT+ENTER tuşlarına basarak B1 hücresini terk edin. Bu şekilde formül DİZİ formül haline gelecektir.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;1;MAK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))-1);A1)

Ya da aşağıdaki formülü kullanabilirsiniz.

=EĞER(ESAYIYSA(BUL(" ";A1;1));PARÇAAL(A1;1;BÜYÜK(EĞER(PARÇAAL(A1;SATIR($1:$1024);1)=" ";SATIR($1:$1024);"");1)-1);A1)

Korhan Bey, ekteki dosyada verdiğiniz formülü uyguladım ve bir önceki mesajımda belirttiğim üzere:

"amacım 6.000 küsur satırın boşlukla ayrılmış son kelimesi olan rakamları bir yan sütuna kırpıp, sonrasında filtreleyerek kırpılmış rakamları silip, listenin geri kalanındaki iki sütunu birleştirerek fiyatsız bir fiyat listesi oluşturmak."

Yine ekteki dosyanın son sekmelerine göz atarsanız, tam olarak aradığım şeyi anlatmaya çalıştım.

 

[Korhan Ayhan]

Selamlar,

Eklediğiniz örnek dosyanızın içinde bir veri görünmüyor. Kontrol edermisiniz.

 

[trakonya]

Selamlar,

Eklediğiniz örnek dosyanızın içinde bir veri görünmüyor. Kontrol edermisiniz.

Kontrol edilmiş dosyam

 

[Korhan Ayhan]

Selamlar,

Siz ilk mesajınızda son kelimeyi ayırmak istiyorum demiştiniz. Oysaki daha sonraki mesajlarınızda cümlenin sonundaki sayıları ayırmak istiyorum diye belirtmişsiniz. Durum böyle olunca önerdiğim formüller işe yaramaz.

Aşağıdaki kod cümlede geçen tüm sayısal verileri siler. Kodu eklediğiniz dosyadaki son sayfada çalıştırın. A sütunundaki verilerden sayıları silip B sütununa listeler ve B sütunundaki veri ile C sütunundaki veriyi D sütununda birleştirir.

Option Explicit
 
Sub CÜMLEDEKİ_SAYILARI_SİL()
    Dim X As Long, Y As Byte
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        
    Range("B:B,D:D").ClearContents
    
    For X = 2 To Cells(Rows.Count, 1).End(3).Row
        Cells(X, 2) = Cells(X, 1)
        
        For Y = 0 To 9
            Cells(X, 2).Replace What:=Y, Replacement:="", LookAt:=xlPart
        Next
        
        Cells(X, 2) = Trim(Cells(X, 2))
        Cells(X, 4) = Cells(X, 2) & IIf(Cells(X, 3) = "", "", " " & Cells(X, 3))
    Next
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
 
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[trakonya]

Selamlar,

Siz ilk mesajınızda son kelimeyi ayırmak istiyorum demiştiniz. Oysaki daha sonraki mesajlarınızda cümlenin sonundaki sayıları ayırmak istiyorum diye belirtmişsiniz. Durum böyle olunca önerdiğim formüller işe yaramaz.

Aşağıdaki kod cümlede geçen tüm sayısal verileri siler. Kodu eklediğiniz dosyadaki son sayfada çalıştırın. A sütunundaki verilerden sayıları silip B sütununa listeler ve B sütunundaki veri ile C sütunundaki veriyi D sütununda birleştirir.

Korhan Bey;

Öncellikle dikkat çektiğiniz durumu açıklamaya çalışayım, şöyle ki:

düzenlemeye çalıştığım verilerde, aşağıdaki örneklerdeki gibi satırların sonlarında "kelime/sayı" olabilir de, olmayabilir de.

barilla spagetti 500gr x 24 15
nuhun ankara 2al 1 öde 500 gr x 8 12
pastavilla kelebek 500 gr

ve yine bu satırlarda sondaki kelime/rakam dışında sayısal veriler olabilir.

yukarıdaki örneklerde de görüldüğü üzere verilen sonundaki "sembol öbeği" kelime yada sayı olabilirken benzer bir durumu verilerin başındaki "sembol öbeği" için değerlendirilecek olsa, kod kullanmaya gere kalmaksızın, "metnisutunaçevir" formülüyle basitçe halledebilecekken

derdimi anlatamamamdan dolayı
sağlıklı örnekleri sunamamamdan dolayı

sizi uğraştırdım :redface:

"Aşağıdaki kod cümlede geçen tüm sayısal verileri siler" buyurmuşsunuz, verilerimin fiyatlardan başkaca da sayılar içermesinden mütevellit, affınıza mahçuben kodu denemiyorum bile.

son tahlilde makarna örneklerinde de işime yarayabilecek türden bir "sondan öbek kırpma" kodu/formülü varsa arz eder, ilginize mahçubiyet dolu şükranlarımı sunarım.

 

[Korhan Ayhan]

Selamlar,

"Sembol Öbeği" diye belirttiğiniz bölüm değişkense "METNİ SÜTUNLARA DÖNÜŞTÜR" özelliğide sizin işinize yaramayacaktır. Bu özelliği düzenli veri yapılarında sağlıklı kullanabilirsiniz.

Ben verdiğiniz örneklerden yola çıkarak aşağıdaki kodu hazırladım. Ayrıca örnek dosyada ekledim. İncelermisiniz.

Option Explicit
 
Sub DÜZENLE()
    Dim X As Long, BUL As Integer
 
    Range("B:B").ClearContents
 
    For X = 1 To Range("A65536").End(3).Row
        BUL = Evaluate("=MIN(IF(ISNUMBER(MID(""" & Cells(X, 1) & """,ROW($1:$1024),1)*1),ROW($1:$1024),""""))")
        If BUL > 0 Then
            Cells(X, 2) = Mid(Cells(X, 1), 1, BUL - 1)
        Else
            Cells(X, 2) = Cells(X, 1)
        End If
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[trakonya]

Selamlar,

"Sembol Öbeği" diye belirttiğiniz bölüm değişkense "METNİ SÜTUNLARA DÖNÜŞTÜR" özelliğide sizin işinize yaramayacaktır. Bu özelliği düzenli veri yapılarında sağlıklı kullanabilirsiniz.

Korhan Bey; sembol öbeğinin "değişkenliği"nden kastınızı tam olarak anlayamasam da, listemdeki 6000 küsur satırı ihtiyaçlarım dahilinde düzenli kılan bi özellik var:

Kırpmak istediğim son öbeklerin "bir boşlukla ayrıldığını" teker teker kontrol ettim. zaten ulaşmaya çalıştığım nokta daha önceki mesajlarda belirttiğim üzere

- son öbekleri yan sütuna kırpmak
- kırpıkları filtrelemek
- filtreden rakamları silmek, kelimeleri bırakmak
- sütunları birleştirmek

Bu şekilde fiyat sıfatı taşıyan ve bir boşlukla ayrıldığı teker teker kontrol edilen son rakamlardan arınmak.

Ve tabii ki fiyat sıfatı taşımayan diğer tüm rakamları oldukları şekilde muhafaza etmek.

AbcXY2_fb @22cs- a,5 lalala 15
2 500gr LXX*bt

Örneğindeki gibi sözde düzensiz olan verilerimin %95 oranında kurallı şekilde bir boşlukla ayrıldığı ve kalan oranın satır ortasında kontrollü/kontrolsüz olduğu bir durumda; son öbek yerine ilk öbekten kurtulmaya çalışacak olursam veri-->metni sütunadönüştür-->sınırlandırılmış-->boşluk adımlarıyla pek kolayca yapılabileceğini düşünüyorum.

ve yine gönderdiğiniz kod maalesef fiyat sıfatı taşımayan rakamsal verileri sileceğinden işimi görmeyecek.

 

[Korhan Ayhan]

Selamlar,

En azından 50-100 satır içeren bir örnek dosya ekleyip hangi bölümleri kırpmak istediğinizi belirtirseniz belki çözüme ulaşabiliriz.

 

[trakonya]

Selamlar,

En azından 50-100 satır içeren bir örnek dosya ekleyip hangi bölümleri kırpmak istediğinizi belirtirseniz belki çözüme ulaşabiliriz.

inşallah

 

[Korhan Ayhan]

Selamlar,

Son eklediğiniz örnek dosyanızın son sayfasında;

B2 hücresine aşağıdaki dizi formülünü uygulayın. Ve alt hücrelere sürükleyin.

=EĞER(ESAYIYSA(BUL(" ";A2;1));PARÇAAL(A2;1;MAK(EĞER(PARÇAAL(A2;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))-1);A2)

C2 hücresine aşağıdaki dizi formülünü uygulayın. Ve alt hücrelere sürükleyin.

=EĞER(ESAYIYSA(BUL(" ";A2;1));EĞER(ESAYIYSA(PARÇAAL(A2;MAK(EĞER(PARÇAAL(A2;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))+1;255)*1);PARÇAAL(A2;MAK(EĞER(PARÇAAL(A2;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))+1;255)*1;PARÇAAL(A2;MAK(EĞER(PARÇAAL(A2;SATIR($1:$1024);1)=" ";SATIR($1:$1024);""))+1;255));A2)

Eğer formülle çözüm dosyanızı ağırlaştırırsa aşağıdaki kodu da kullanabilirsiniz.

Option Explicit
 
Sub DÜZENLE()
    Dim X As Long, Y As Byte, VERİ() As String
    
    Application.ScreenUpdating = False
    
    Range("B2:C65536").ClearContents
    
    For X = 2 To Range("A65536").End(3).Row
        If InStr(1, Cells(X, 1), " ") > 0 Then
            VERİ = Split(Cells(X, 1), " ")
            For Y = 0 To UBound(VERİ) - 1
                If Cells(X, 2) = "" Then
                    Cells(X, 2) = VERİ(Y)
                Else
                    Cells(X, 2) = Cells(X, 2) & " " & VERİ(Y)
                End If
            Next
        
            Cells(X, 3) = VERİ(UBound(VERİ))
        Else
            Cells(X, 2) = Cells(X, 1)
        End If
    Next
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Ekli dosyada her iki çözüm şeklinide bulabilirsiniz. İncelermisiniz.

 

[trakonya]

Sayenizde nihayet listeyi düzenleyebilicem Korhan Bey, aşırı derecede teşekkürlerimi sunuyorum k::

Düzenlemem bitince listeyi axcesste akordiyon menü hâline getirmeye çalışacam.
Ve gelişmiş bir arama ekranına ihtiyacım olacak.
büyük-küçük harfte sorun çıkarmayanından ve yazarken arama yapmaya başlayıp sonuçları sıralayacak tipten.

Bu konularda da başınızı ağrıtmayı vaat ediyorum ancak bu konudan devam etmek doğru olur mu, yoksa başka bir konu açmak gerekir mi karar veremiyorum

sizi tekrar buralardan selamlayacağa benziyorum. :roll:

 

[trakonya]

Evet, tekrar ben geldim. Öncelikle bu mesajımı mazur görmenizi rica ederim, konudan sapmaya başlıyorum çünkü. Hatta belki de istediğim şeyin excelle alakası yok (!)

Şöyle ki: Önceki mesajlarımda da belirttiğim üzere artık 7.000 satırlık bir listem var ve derdim; bu listemi windowsun "regedit" yada "gpedit.msc" konsollarındaki gibi ağaç menü hâline getirebilmek.

googleladığım kadarıyla istediğime yakın işler yapan birkaç program buldum ancak bunlar daha çok web sitelerine menü oluşturmak için tasarlanmış programlar. benim için eksisi: verileri excelden import etme lüksümün olmayışı.

+ "regedit" arayüzünü daha mâkul kılan şey ise arama sonucunun tam adresinin en altta görünmesi.

"menü oluşturma", "ağaç menü" gibi anahtar kelimelerle forumda arama yaptım, şimdi derdimi anlatmaya arama sonuçlarından mı devam etsem, yeni başlık mı açsam bilemedim. aradığım şeyin excelle alakası yoksa forumu kirletmeyeyim dedim