Sağdan PARÇAAL ile Kelime ayırma

[Orion1]

15 nolu mesajda yazdığım ktf doğru cevabı vermesi lazım.

 

[Ömer BARAN]

Önceki kod cevabımı güncelledim, sayfayı yenileyerek kontrol ediniz.

 

[sonageldik]

Önceki kod cevabımı güncelledim, sayfayı yenileyerek kontrol ediniz.

Sub SON_KELİME()
For sat = 1 To Cells(Rows.Count, "A").End(3).Row
    Set brnn = Cells(sat, "A").Find(" ", , , xlPart)
    If Not brnn Is Nothing Then
        brn = WorksheetFunction.Search(" ", VBA.StrReverse(brnn), 1)
        Cells(sat, "B") = Mid(Cells(sat, "A"), Len(Cells(sat, "A")) - brn + 2, brn)
        Cells(sat, "A") = Mid(Cells(sat, "A"), 1, Len(Cells(sat, "A")) - brn)
    Else
        Cells(sat, "B") = Cells(sat, "A"): Cells(sat, "A") = ""
    End If
Next: brnn = Empty
MsgBox "İşlem tamamlandı.", vbInformation, "...::... Ö. BARAN ...::..."
End Sub

Evet sorunsuz çalıştı, eline sağlık kardeşim. Çok işime yarayacak

 

[Ömer BARAN]

cc şeklinde başlayan satırı ve bir altındaki boş satırı silebilirsiniz.
Ben silmeyi unutmuşum.

Kolay gelsin.
.

 

[sonageldik]

15 nolu mesajda yazdığım ktf doğru cevabı vermesi lazım.

@Orion1 cahilliğimi mazur gör, ben onu uygulayamadım, beceriksizlik ve iş bilmezlik işte

cc şeklinde başlayan satırı ve bir altındaki boş satırı silebilirsiniz.
Ben silmeyi unutmuşum.

Kolay gelsin.
.

Eyvallah kardeş o şekilde alıntı iletiyi de düzelttim ve notumu aldım. Eline sağlık, çok teşekkür ederim.

 

[Ömer BARAN]

İyi günler, iyi çalışmalar dilerim.

 

[Orion1]

@Orion1 cahilliğimi mazur gör, ben onu uygulayamadım, beceriksizlik ve iş bilmezlik işte

Aşağıdaki linkteki dosyayı inceleyiniz.

DOSYAYI İNDİR

...

 

[sonageldik]

Teşekkürler inceledim. Alt satırlara da A1 den kestiği son kelimeyi uyguluyor

 

[Orion1]

Teşekkürler inceledim. Alt satırlara da A1 den kestiği son kelimeyi uyguluyor

Modüldeki KTF yi aşağıdaki ile değiştiriniz.

Function evrendondur(ByRef deg As Variant)
Dim say As Byte
deg = VBA.StrReverse(deg)
say = InStr(1, deg, " ")
deg = Left(deg, say - 1)
evrendondur = StrReverse(deg)
End Function

 

[vardar07]

Runtime error 9 hatası aldım

Sayfa adını Set k = Sheets("Sayfa2") kendinize göre düzenlediniz mi?

 

[sonageldik]

Modüldeki KTF yi aşağıdaki ile değiştiriniz.

Function evrendondur(ByRef deg As Variant)
Dim say As Byte
deg = VBA.StrReverse(deg)
say = InStr(1, deg, " ")
deg = Left(deg, say - 1)
evrendondur = StrReverse(deg)
End Function

Son kelimeleri aşağı doğru aldı ama aldığı yerde kalan kelimeleri kesmedi, makroya ilave yapmak lazım sanırım

 

[sonageldik]

Sayfa adını Set k = Sheets("Sayfa2") kendinize göre düzenlediniz mi?

Afedersiniz sayfa numarasını değiştirmeyi unutmuşum ve çalıştı. Ancak ilk satırın karşısını boş bıraktı alttakileri olması gerektiği gibi son kelimeden ayırıp sağdaki sütuna aldı.

sat = 2
For a = 2 To k.Range("A65500").End(3).Row

2 değerini de aşağıdaki gibi 1 yaptım baştan sona işlevi yerine getirdi. Bu da çok güzel oldu. Eline sağlık arkadaşım, zahmet verdim ama arayıp soranlara da güzel bir kaynak oluşturdunuz. Başarılar

Sub ayir()
Set k = Sheets("Sayfa1")
sat = 1
For a = 1 To k.Range("A65500").End(3).Row
    ad = Split(k.Cells(a, "A"), " ")
    ReDim ad1(UBound(ad) - 1)
    For b = LBound(ad) To UBound(ad) - 1
        ad1(b) = ad(b)
    Next
    k.Cells(sat, "A") = Join(ad1, " ")
    k.Cells(sat, "B") = ad(UBound(ad))
    sat = sat + 1
Next
End Sub

Katkı ve destek sağlayan herkese çok teşekkür ederim. Harika insanlarsınız. Kolay gelsin

 

[Ömer BARAN]

Tekrar merhaba.

Sayın sonageldik, bence bu işlem için kod kullanmaya hiç gerek yoktu ama neyse sonuca ulaşıldı zaten.

Ancak formül kullanarak çözüm önerisiyle ilgili şunu söyleyeyim:

-- 9 numaralı cevapta önerdiğim aşağıdaki formülü C1 hücresine uygulayın,.

=[COLOR="red"]EĞER[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]="";"";[COLOR="red"]EĞER[/COLOR]([COLOR="red"]ESAYIYSA[/COLOR]([COLOR="red"]BUL[/COLOR](" ";[COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);1));[COLOR="red"]PARÇAAL[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);[COLOR="red"]BUL[/COLOR]("|";[COLOR="red"]YERİNEKOY[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" ";"|";[COLOR="red"]UZUNLUK[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]))-[COLOR="red"]UZUNLUK[/COLOR]([COLOR="red"]YERİNEKOY[/COLOR]([COLOR="Red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" ";"")));1)+1;255);[B][COLOR="Blue"]A1[/COLOR][/B]))

-- B1 hücresine de aşağıdaki formülü uygulayın,

=[COLOR="Red"]YERİNEKOY[/COLOR]([COLOR="Red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" "&C1;"")

-- her iki formülü listeniz boyunca kopyalayın,
-- sonucun sabit kalması için B ve C sütununda formül uygulanmış alanı kopyalayıp, DEĞER olarak yapıştırın
-- A sütununu silin.

İsteğinizin formül ile elde edilmiş sonucu aynen istediğiniz gibi olacaktır.
.

 

[sonageldik]

Tekrar merhaba.

Sayın sonageldik, bence bu işlem için kod kullanmaya hiç gerek yoktu ama neyse sonuca ulaşıldı zaten.

Ancak formül kullanarak çözüm önerisiyle ilgili şunu söyleyeyim:

-- 9 numaralı cevapta önerdiğim aşağıdaki formülü C1 hücresine uygulayın,.

=[COLOR="red"]EĞER[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]="";"";[COLOR="red"]EĞER[/COLOR]([COLOR="red"]ESAYIYSA[/COLOR]([COLOR="red"]BUL[/COLOR](" ";[COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);1));[COLOR="red"]PARÇAAL[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);[COLOR="red"]BUL[/COLOR]("|";[COLOR="red"]YERİNEKOY[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" ";"|";[COLOR="red"]UZUNLUK[/COLOR]([COLOR="red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]))-[COLOR="red"]UZUNLUK[/COLOR]([COLOR="red"]YERİNEKOY[/COLOR]([COLOR="Red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" ";"")));1)+1;255);[B][COLOR="Blue"]A1[/COLOR][/B]))

-- B1 hücresine de aşağıdaki formülü uygulayın,

=[COLOR="Red"]YERİNEKOY[/COLOR]([COLOR="Red"]KIRP[/COLOR]([B][COLOR="Blue"]A1[/COLOR][/B]);" "&C1;"")

-- her iki formülü listeniz boyunca kopyalayın,
-- sonucun sabit kalması için B ve C sütununda formül uygulanmış alanı kopyalayıp, DEĞER olarak yapıştırın
-- A sütununu silin.

İsteğinizin formül ile elde edilmiş sonucu aynen istediğiniz gibi olacaktır.
.

C1 ve ardından B1 bu da farklı bir bakış ve sonuç olumlu. Teşekkür ederim arkadaşım. Çok sağol. İyi çalışmalar dilerim

 

[Orion1]

Son kelimeleri aşağı doğru aldı ama aldığı yerde kalan kelimeleri kesmedi, makroya ilave yapmak lazım sanırım

KTF yi C sütununa yazın.
B sütununada B1 hücresine aşağıdaki formülü girin.
Dosya linktedir.

DOSYAYI İNDİR

=SOLDAN(A1;UZUNLUK(A1)-UZUNLUK(C1)-1)