cümle-kelime-hece

klop01 · 31 Ocak 2018

Sayın leumruk,
Son değişiklikle -tamamı büyük harfle yazılmış olan kelime ve cümleler hariç- hecelere ayırma ile ilgili bir sorun gözükmemekte.
İlkokullarda büyük harflerle ilgili çalışmalarda büyük harfleri de hecelere ayırması özelliği belki işe yarayabilir.
SONRADAN EKLENEN BİLGİ: Alttaki 22 ve 23. iletilerde sayın leumruk tarafından açıklanan duruma göre kod yenilenerek dosyalar tekrar yüklenmiştir. Şimdi büyük harfleri de hecelere ayırıyor.

İzniniz olmadan yararlı olur düşüncesi ile aşağıdaki işlemleri yapan bir dosya oluşturdum.
>>> Sayın Ömer BARAN'ın 15. mesajda verdiği kodu sizin koda yapıştırarak B1 hücresinden başlayarak sağa doğru kelime kelime ayırma yapmasını sağladım.
>>> Hecelere ayrılmış kelimeleri silmek için makro kaydetme yöntemi ile kod oluşturup butona bağladım.

Kopyala yapıştır ve makro kaydetme dışında makro bilgim yoktur. Yaptığım işlemden sonra Modül 2 adında bir modül daha oluşmuş.

Vermiş olduğunuz emekler için teşekkürler.

http://www.dosya.tc/server11/zxhe8e/HECELEME_3.rar.html

leumruk · 31 Ocak 2018

Rica ederim. Katkınızdan dolayı teşekkür ederim.

Büyük harf sorununu halletmiştim. Eklediğiniz dosyada eski kodu kullanmışsınız. Yenileriyle değiştirirseniz büyük harflerde de çalışacaktır.

leumruk · 31 Ocak 2018

Kodları yenilemişim, dosya eski kalmış. Dosyayı da yenisiyle değiştirdim. Şu an sorunsuz görünüyor.

klop01 · 31 Ocak 2018

Sayın leumruk,
21. iletideki dosyaları ve açıklamamı yeniledim.
Sorunsuz çalışıyor kod.

Sayın Ömer BARAN'ın verdiği ek kod kelimeleri teker teker hücrelere dağıtarak hecelere ayırıyor.
Bunun sadece bir hücre içerisinde kalarak heceleme yapan hâli de işe yarayabilir.
Rica etsek bu konuda kodda düzenleme yapabilir mi?

Ömer BARAN · 31 Ocak 2018

Merhaba.

Sayın leumruk'un eline sağlık çok güzel bir çalışma oluyor.

Sayın leumruk'un müsadesiyle, konu cümle - kelime - hece olduğuna göre;
cümleden başlayarak gitmeye yönelik, Sayın leumruk'un kod'larına biraz ilave yaptım.

-- Tek harfli kelimelerdeki soruna ilişkin ilave yaptım,
-- A1 hücresine yazılan cümle A sütununda kelimelere ayrılmış durumda,
-- B2 hücresinden itibaren de bu kelimelerin heceleri sütunlara dağıtılmış
olacak şekilde,
yaptığım düzenleme ekteki belgede.

Sanırım Sayın klop01'in de istediği bir durum idi.
.

Kod:

Sub heceleme_leumruk_brn()
If Cells(Rows.Count, 1).End(3).Row > 1 Then
    ssat = Cells.SpecialCells(xlCellTypeLastCell).Row
    ssut = Cells.SpecialCells(xlCellTypeLastCell).Column
    Range(Cells(2, 1), Cells(ssat, ssut)).ClearContents
End If
If [A1] = "" Then Exit Sub
metin = [A1]
    noktalama = Array("'", "´", "`", ":", ";", "=", ".", ",", "-", "+", "~*", "/", "(", ")", """", "!", "^", "$", "#", "%", "&", "{", "[", "]", "}", "\", "~?", "_", "<", ">", "|", "@", "¨", "~")
    For a = 0 To UBound(noktalama)
        [A1].Replace What:=noktalama(a), Replacement:=""
    Next
[A1].TextToColumns Destination:=[B1], Space:=True
sonsut = [A1].End(xlToRight).Column
[A1] = metin
For sat = 2 To sonsut
    Cells(sat, 1) = Cells(1, sat)
Next
Range(Cells(1, 2), Cells(1, sonsut)).ClearContents

harf = "aâeıiîoöuûüAÂEIİÎOÖUÛÜ"
For satt = 2 To Cells(Rows.Count, 1).End(3).Row
    deg = Cells(satt, 1)
    If Len(deg) = 1 Then
        Cells(satt, 2) = deg
        GoTo 10
    End If
    For X = Len(deg) To 1 Step -1
        t = t + 1
        If X <> Len(deg) Then
            say = InStr(harf, Mid(deg, X, 1))
            unlusay = InStr(harf, Mid(deg, X + 1, 1))
            If X = 2 And say = 0 Then
                If InStr(harf, Mid(deg, X - 1, 1)) = 0 Then
                    hece = hece & "-" & StrReverse(Mid(deg, X - 1, t + 1))
                    Exit For
                End If
            End If
            If unlusay > 0 Or X = 1 Then
                If say > 0 And X <> 1 Then
                    hece = hece & "-" & StrReverse(Mid(deg, X + 1, t - 1))
                    t = 1
                Else
                    hece = hece & "-" & StrReverse(Mid(deg, X, t))
                    t = 0
                End If
            End If
        End If
    Next
    Cells(satt, 2) = Mid(StrReverse(hece), 1, Len(hece) - 1)
    hece = ""
10
Next

Range("B2:B" & sat).TextToColumns Destination:=[B2], OtherChar:="-"
For sut = 2 To sat
    Columns(sut).EntireColumn.AutoFit
Next
[B]End Sub[/B]

klop01 · 31 Ocak 2018

Sayın BARAN,
Yapmış olduğunuz şekil gayet güzel oldu. Sağ olun.

Benim dediğim biraz farklı bir durum. Şöyle:
Sizin yaptığınız Sayfa1'de olsun.
Sayfa2'de A1'de cümle var. B1'de bu cümle hecelere ayrılmış durumda.
Yani tek bir hücrenin içerisindeki cümlenin tek bir hücre içerisinde hecelere ayrılması durumu.

Sonradan aklıma gelen şu özellik de katılabilir dosyaya.
A1'deki cümlenin B1'de toplam kaç heceye ayrıldığını sayan bir formül. Yani cümledeki toplam hece sayısını gösteren bir formül.

Yukarıda yazdıklarım şu an için ihtiyacım olan bir şey değil. Dosyanın daha fazla özellik göstermesi içindir.
Vaktiniz varsa çalışma farklı ihtiyaçlara yönelik özellik kazanmış olur.

Saygılarımla.

Ömer BARAN · 31 Ocak 2018

.
Son cevabımdaki kod ve örnek belgede, noktalama işaretlerinin temiziğini de ekleyerek önceki cevabımı güncelledim.
.

leumruk · 31 Ocak 2018

Ömer BARAN' Alıntı:
Merhaba.

Sayın leumruk'un eline sağlık çok güzel bir çalışma oluyor.

Sayın leumruk'un müsadesiyle, konu cümle - kelime - hece olduğuna göre;
cümleden başlayarak gitmeye yönelik, Sayın leumruk'un kod'larına biraz ilave yaptım.

Merhaba,
Kodları ve dosyayı Ömer Bey'in bahsettiği tek harfli kelimelerde çalışacak şekilde güncelledim.
Ömer Bey, çalışmaya katkınızdan dolayı ben de size teşekkür ederim.
İsmimi vurgulama nezaketinizden dolayı da ayrıca teşekkür ederim.

klop01 · 31 Ocak 2018

Sayın leumruk,
Son dosyanızdaki kod hecelerle beraber kelimeler arasına da "-" işareti koyuyor. Örnek: A-li- e-ve -gel-di.
Dikkatinize.

Ömer BARAN · 31 Ocak 2018

Estağfurullah Sayın leumruk. Kod sizin, başka türlü olamazdı.

Sayın klop1; belirttiğiniz hususa ilişkin olarak 15 numaralı cevabımın ilk satırındaki yapı kullanılabilir.
Sayın leumruk'un kod'undaki End Sub satırının hemen üstündeki MsgBox satırı yerine aşağıdaki satırı kullanabilirsiniz.
.

Kod:

MsgBox Replace(Replace(Mid(StrReverse(hece), 1, Len(hece) - 1), " -", " "), "- ", " ")

klop01 · 31 Ocak 2018

Ömer Hoca'm, sağ olun.

leumruk · 31 Ocak 2018

Sn. klop, KTF'yi yazdırdınız sonunda...

7. mesajdaki dosyayı ham haliyle bırakıyorum. Çalışmalarında kullanacak kişiler için kolaylık olacaktır.
Kodların ham halinin değişik çalışmalarda kullanılabilmesi için KTF şeklinde düzenledim.
Cümle bazında hecelerine ayırmaya yönelik bir de kodlama hazırladım. Bu kodlamadan yola çıkarak farklı makrolar oluşturabilirsiniz.

Ayrıca makro yazmadan fonksiyon olarak da kullanabilirsiniz.
Örnek:

Kod:

=hecele(G2)
"G2 hücresindeki kelimeyi hecelerine ayırır."

KTF:

Kod:

Function hecele(kelime)
harf = "aâeıiîoöuûüAÂEIİÎOÖUÛÜ"
deg = kelime
If Len(deg) <= 1 Then
hecele = deg
Exit Function
End If
For x = Len(deg) To 1 Step -1
t = t + 1 'geçilen harf sayısı
If x <> Len(deg) Then
say = InStr(harf, Mid(deg, x, 1))
unlusay = InStr(harf, Mid(deg, x + 1, 1))
If x = 2 And say = 0 Then
    If InStr(harf, Mid(deg, x - 1, 1)) = 0 Then
        hece = hece & "-" & StrReverse(Mid(deg, x - 1, t + 1))
        Exit For
    End If
End If
If unlusay > 0 Or x = 1 Then
If say > 0 And x <> 1 Then
hece = hece & "-" & StrReverse(Mid(deg, x + 1, t - 1))
t = 1
Else
hece = hece & "-" & StrReverse(Mid(deg, x, t))
t = 0
End If
End If
End If
Next
hecele = Trim(Replace(Replace(Mid(StrReverse(hece), 1, Len(hece) - 1), " -", " "), "- ", " "))
End Function

Kod:

Function NoktalamaSil(metin)
sozcuk = metin
For a = 33 To 47
sozcuk = Replace(sozcuk, Chr(a), "")
Next
For b = 58 To 64
sozcuk = Replace(sozcuk, Chr(b), "")
Next
For c = 91 To 96
sozcuk = Replace(sozcuk, Chr(c), "")
Next
For d = 123 To 191
sozcuk = Replace(sozcuk, Chr(d), "")
Next
NoktalamaSil = sozcuk
End Function

Kod:

Sub CumleHecele()
MsgBox hecele(NoktalamaSil([a1]))
End Sub

leumruk · 31 Ocak 2018

Son olarak Noktalama işaretlerini kaldıran bir KTF yazdım ve 32. mesajı bu doğrultuda güncelledim. İyi çalışmalar diliyorum.

Ömer BARAN · 31 Ocak 2018

Merhaba, Sayın leumruk. :bravo: :bravo: .

Çok güzel bir kod ortaya çıkarttınız. :bravo: :bravo: .

Sanırım Cumle_Ayir kod'unda, ilk kelime işlem sonucuna yansımıyor.
For c =0 To Ubound(cumle)
olunca da düzeliyor.
.

leumruk · 31 Ocak 2018

Ömer BARAN' Alıntı:
Merhaba, Sayın leumruk. :bravo: :bravo:

Çok güzel bir kod ortaya çıkarttınız. :bravo: :bravo:

Sanırım Cumle_Ayir kod'unda, ilk kelime işlem sonucuna yansımıyor.
For c =0 To Ubound(cumle)
olunca da düzeliyor.
.

Teşekkürler Ömer Bey,
O makroyu değiştirip daha basit bir makro yazmıştım. CümleHecele isimli... Kimse indirmemiştir diye düşünmüştüm, size yakalanmışım.

klop01 · 1 Şubat 2018

Sayın leumruk,
Sağ olun.

=hecele(NoktalamaSil(A1))
Se-ni her tür-lü nok-san-dan ten-zih- e-de-riz Se-nin bi-ze- öğ-ret-ti-ğin-den baş-ka bi-zim hiç-bir bil-gi-miz yok-tur Sen her-şe-yi hak-kıy-la bi-lir her- i-şi hik-met-le ya-par-sın
ve
=hecele(A1)
Se-ni her tür-lü nok-san-dan ten-zih- e-de-riz. Se-nin bi-ze- öğ-ret-ti-ğin-den baş-ka bi-zim hiç-bir bil-gi-miz yok-tur. Sen her-şe-yi hak-kıy-la bi-lir, her- i-şi hik-met-le ya-par-sın.

formüllerinde işaretli hataları veriyor.

Anladığım kadarı ile ünlü ile bitip ünlü ile başlayan(Örnek: kara ay) iki kelime arasında ve ünsüz ile bitip ünlü ile başlayan(Örnek: Erol Umut) kelimeler arasına da "-" işareti atıyor.

Zeki Gürsoy · 1 Şubat 2018

Güzel çalışma.

leumruk · 1 Şubat 2018

Sn klop01,
Replace ile halledilebilir. Şu an bilgisayarda değilim. Yarın bir önceki cümle makrosunu da düzenleyip 2 alternatifli kodlama ekleyeceğim. İyi geceler diliyorum.

leumruk · 1 Şubat 2018

Selamlar,
Önceki mesajımdaki kodlamayı "Replace" yöntemiyle düzelttim. Fakat kodun ilerleyiş mantığına çok uygun değil. Bir nevi fazlalıkları tıraşlamış oldum. Cümleyi tek bir sözcük gibi ele alıyor. Doğru sonuç vermesinin nedeni boşluk karakterini ünsüz harf olarak değerlendiriyor. Bundan dolayı heceye ayırdığında doğru sonuç alıyoruz. Alternatif olması açısından o mesajdaki örneği silmiyorum.

Kodlamanın çalışma mantığına uygun örneği bu mesajıma ekliyorum. Bu kod Cümledeki her kelimeyi ayrı ayrı ele alıyor. Döngü sonunda birleştiriyor.

Kod:

Function hecele(kelime)
harf = "aâeıiîoöuûüAÂEIİÎOÖUÛÜ"
cumle = Trim(kelime)
If Len(cumle) <= 1 Then
hecele = cumle
Exit Function
End If
cumle = Split(cumle, " ")
For c = 0 To UBound(cumle)
deg = cumle(c)
For x = Len(deg) To 1 Step -1
t = t + 1 'geçilen harf sayısı
If x <> Len(deg) Then
say = InStr(harf, Mid(deg, x, 1))
unlusay = InStr(harf, Mid(deg, x + 1, 1))
If x = 2 And say = 0 Then
    If InStr(harf, Mid(deg, x - 1, 1)) = 0 Then
        hece = hece & "-" & StrReverse(Mid(deg, x - 1, t + 1))
        Exit For
    End If
End If
If unlusay > 0 Or x = 1 Then
If say > 0 And x <> 1 Then
hece = hece & "-" & StrReverse(Mid(deg, x + 1, t - 1))
t = 1
Else
hece = hece & "-" & StrReverse(Mid(deg, x, t))
t = 0
End If
End If
End If
Next
metin = metin & " " & Mid(StrReverse(hece), 1, Len(hece) - 1)
hece = ""
Next
hecele = Trim(metin)
End Function

klop01 · 1 Şubat 2018

Sayın leumruk,
Güzel olmuş. Sağ olun.

Gerek sayın Ömer BARAN'ın 25. iletide verdiği dosya gerekse sizin 39. iletideki dosyanız farklı ihtiyaçları görmeye yönelik yararlı birer çalışma oldu.

İstatistik sonuç olarak lazım olabilir düşüncesi ile forumdan bulduğum aşağıdaki formül A1 hücresindeki kelime arasındaki boşlukları sayarak ve A7 hücresindeki - işaretlerini sayarak ve 1 eklenerek hece sayısını buluyor.
A7'de cümlenin noktalama işaretlerinden arındırılmış hecelenmiş şekli var.
Kırmızı ile gösterdiğim +1 ilgili hücrelerde metin yokken 1 sonucunu gösteriyor. Bunu nasıl engelleyebiliriz?

Kod:

=UZUNLUK(KIRP(A1))-UZUNLUK(YERİNEKOY(A1;" ";""))[B][COLOR="Red"]+1[/COLOR][/B]+UZUNLUK(A7)-(UZUNLUK(YERİNEKOY(A7;"-";"")))

cümle-kelime-hece

klop01

Ekli dosyalar

leumruk

Uzman

leumruk

Uzman

klop01

Ömer BARAN

Uzman

Ekli dosyalar

klop01

Ömer BARAN

Uzman

leumruk

Uzman

klop01

Ömer BARAN

Uzman

klop01

leumruk

Uzman

Ekli dosyalar

leumruk

Uzman

Ömer BARAN

Uzman

leumruk

Uzman

klop01

Zeki Gürsoy

Uzman

leumruk

Uzman

leumruk

Uzman

Ekli dosyalar

klop01