• DİKKAT

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

Hücredeki kelimeleri ayırmak

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba arkadaşlar. D sütununda yazı ile dolu hücrelerdeki kelimeleri H sütununda kelime kelime ayrılması makro kodu yardımıyla mümkün olur mu !

örneğin D1 hücresinde "Domates fiyatları yüzde beş arttı" yazısını
Domates
fiyatları
yüzde
beş
arttı

şeklinde ayırtabilir miyiz. D2 ve aşağıya doğru dolu hücreleri kelimelere ayrılması mümkün mü ?
 
Son düzenleme:
Aşağıdaki kullanıcı tanımlı fonksiyonu deneyebilirsiniz.

Kod: 
=KPARÇAAL(Hücre;Kaçıncı_Kelime)

Kod: 
=KPARÇAAL(A1;1)

Kod: 
Function KPARÇAAL(Veri As Range, Kaçıncı_Kelime As Integer)
    KPARÇAAL = Split(Veri.Value, " ")(Kaçıncı_Kelime - 1)
End Function
 
Çok teşekkür ediyorum sayın Korhan Ayhan, çok iyi oldu. Sağlıcakla kalın.
 
Korhan üstadım, bu çözüm çok işime yaradı, tekrar teşekkür ederim. Acaba şöyle bir çözüm olma olasılığı var mı ? A1 hücresindeki kelimeleri (boşlukları kriter alarak) B sütununa dağıtması formülleme dışında sadece kod ile tek hamlede mümkün olur mu ?
 
Son düzenleme:
Aşağıdaki kodu kullanabilirsiniz.

Kod: 
Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer
    
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
    
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(Veri.Value, " ")
        For X = 0 To UBound(Kelime)
            Cells(Veri.Row, X + 2) = Kelime(X)
        Next
    Next
    
    Cells.EntireColumn.AutoFit
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sayın Korhan Ayhan çok çok teşekkür ediyorum. Allah razı olsun. Harika bir kod. Bu kod fazlasıyla işimi görecek. Kod yapısının nasıl değiştiğini gözlemlemek açısından sadece minik bir ricam olacak : ayrılan kelimeleri B sütununda yukarıdan aşağıya doğru yazdırmak isteseydik kod yapısında nereyi değiştirmek lazım ?
 
Aşağıdaki kodu kullanabilirsiniz.

Kod: 
Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer, Satir As Long
    
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
    Satir = 1
    
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(Veri.Value, " ")
        For X = 0 To UBound(Kelime)
            Cells(Satir, 2) = Kelime(X)
            Satir = Satir + 1
        Next
    Next
    
    Range("B:B").EntireColumn.AutoFit
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korahn üstadım, mükemmel x mükemmel oldu. Aynı konuda 3 ayrı alternatif oldu ki. kör istedi bir göz, Korhan üstad verdi 3 göz gibi bir şey oldu. Çok teşekkür ediyorum. Sağlıcakla kalın.
 
Korhan Ayhan' Alıntı:
Aşağıdaki kodu kullanabilirsiniz.

Kod: 
Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer
   
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
   
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(Veri.Value, " ")
        For X = 0 To UBound(Kelime)
            Cells(Veri.Row, X + 2) = Kelime(X)
        Next
    Next
   
    Cells.EntireColumn.AutoFit
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Korhan bey merhaba
Burada A1:A3 hücrelerindeki verilerin tamamını Değilde, Son 2 boşluktan sonrasın, Yani Sağdan 1. ve 2. Boşluklardan Ayırmak mümkün mü ?
Selamlar iyi akşamlar.
 
Deneyiniz.

C++: 
Option Explicit

Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer
   
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
   
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(StrReverse(Veri.Value), " ")
        For X = 0 To WorksheetFunction.Min(1, UBound(Kelime))
            If IsNumeric(StrReverse(Kelime(X))) Then
                Cells(Veri.Row, X + 2) = CDbl(StrReverse(Kelime(X)))
            Else
                Cells(Veri.Row, X + 2) = StrReverse(Kelime(X))
            End If
        Next
    Next
   
    Cells.EntireColumn.AutoFit
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
Option Explicit

Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer
  
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
  
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(StrReverse(Veri.Value), " ")
        For X = 0 To WorksheetFunction.Min(1, UBound(Kelime))
            If IsNumeric(StrReverse(Kelime(X))) Then
                Cells(Veri.Row, X + 2) = CDbl(StrReverse(Kelime(X)))
            Else
                Cells(Veri.Row, X + 2) = StrReverse(Kelime(X))
            End If
        Next
    Next
  
    Cells.EntireColumn.AutoFit
  
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Ellerinize sağlık Korhan bey çok güzel oldu, Küçük bir sorun var ( Ayran 22,00 44,00 ) bir tek bunu bölmüyor, A sütununda yerini de değiştirip denedim ama aynı, oysa aynı karakterlerde ( Lavas 13,00 13,00 ) bu var bunu bölüyor.
 
Ayran 22,00 44,00 ifadesinde boşluk gibi görünen karakterler farklı bir karakter olabilir. Kontrol ediniz.
 
Korhan Ayhan' Alıntı:
Ayran 22,00 44,00 ifadesinde boşluk gibi görünen karakterler farklı bir karakter olabilir. Kontrol ediniz.
Genişletmek için tıkla ...
Aynı ifadeyi silerek elle de yazıp denedim ama yine aynı, hücre yapısında bir sıkıntı yok, çünkü onun yerine ( Lavas 13,00 13,00 ) ı yazıyorum onu bölüyor.
 
Dosyanızı paylaşırsanız sorunu inceleme şansımız olur.
 
HACI46' Alıntı:
Aynı ifadeyi silerek elle de yazıp denedim ama yine aynı, hücre yapısında bir sıkıntı yok, çünkü onun yerine ( Lavas 13,00 13,00 ) ı yazıyorum onu bölüyor.
Genişletmek için tıkla ...
HACI46' Alıntı:
Aynı ifadeyi silerek elle de yazıp denedim ama yine aynı, hücre yapısında bir sıkıntı yok, çünkü onun yerine ( Lavas 13,00 13,00 ) ı yazıyorum onu bölüyor.
Genişletmek için tıkla ...

Korhan bey birde yeni altın üyelerin DVD yi indirme link ini gezindim ama göremedim, hangi link ten indirebilirim.
Selamlar, Sağlıklı günler dileği ile hayırlı geceler.
 
Sorun çözüldü mü anlamadım...

DVD ile ilgili olarak @Hüseyin beye danışınız.
 
Siz şöyle yapın;

A1 hücresini seçin ve F2 tuşuna basın.
Sonra hücrenin sonundaki FAZLA boşlukları temizleyin.

Sonra kodu tekrar deneyin.
 
Ek olarak bu şekilde gereksiz karakter (boşluk) içeren verileriniz varsa kodu aşağıdaki gibi revize etmek daha uygun olacaktır.

C++: 
Option Explicit

Sub KELİMELERİ_AYIR()
    Dim Veri As Range, Son As Long, Kelime As Variant, X As Integer
   
    Range(Cells(1, 2), Cells(Rows.Count, Columns.Count)).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
   
    For Each Veri In Range("A1:A" & Son)
        Kelime = Split(StrReverse(Application.Trim(Veri.Value)), " ")
        For X = 0 To WorksheetFunction.Min(1, UBound(Kelime))
            If IsNumeric(StrReverse(Kelime(X))) Then
                Cells(Veri.Row, X + 2) = CDbl(StrReverse(Kelime(X)))
            Else
                Cells(Veri.Row, X + 2) = StrReverse(Kelime(X))
            End If
        Next
    Next
   
    Cells.EntireColumn.AutoFit
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst