Excel sütun ayırma

[Dogukan34]

Öncelikle herkese merhaba, ay sonu sayımları için ay içinde tüketilen ürünleri whatsapp grubu üzerinden yazıyoruz. Bunları tek tek excele geçirmek çok ciddi zaman alıyor bunun için mesajları whatsapptan kopyalayarak excele yapıştırmak istiyorum ancak metinleri a ve b sütunu olarak ayırmam gerekiyor örneğin;
Yazılan mesaj;
1200 gr patates
1000 gr soğan
100 ml zeytinyağ şeklinde, bunu gr, ml, kg vb. değerlerini tablonun b sütünuna aktarmak istiyorum. Yardımcı olabilecek var mıdır ?

işlem sonunda

ürün	gramaj
patates	1200gr
soğan	1000gr
zeytinyağ	100ml

gibi olmalı

 

[muhasebeciyiz]

Sub Donustur()
Dim cell As Range
Dim value As String
Dim number As Double
Dim unit As String
Dim product As String

For Each cell In Range("A1:A3")
value = cell.value

number = Val(Split(value, " ")(0))
unit = Split(value, " ")(1)
product = Mid(value, InStrRev(value, " ") + 1)

cell.Offset(0, 1).value = product
cell.Offset(0, 2).value = number & " " & unit
Next cell
End Sub

verilerin A1:A3 aralığına yazıldığı varsayılmıştır.İsteğinize göre değiştiriniz.makro çalıştığında istediğiniz gerçekleşmiş olacaktır.

 

[Dogukan34]

Sub Donustur()
Dim cell As Range
Dim value As String
Dim number As Double
Dim unit As String
Dim product As String

For Each cell In Range("A1:A3")
value = cell.value

number = Val(Split(value, " ")(0))
unit = Split(value, " ")(1)
product = Mid(value, InStrRev(value, " ") + 1)

cell.Offset(0, 1).value = product
cell.Offset(0, 2).value = number & " " & unit
Next cell
End Sub

verilerin A1:A3 aralığına yazıldığı varsayılmıştır.İsteğinize göre değiştiriniz.makro çalıştığında istediğiniz gerçekleşmiş olacaktır.

hocam bunu makro oluştur kısmına yazdığımda herhangi bir değişiklik olmadı kıymetli vaktinizi alarak rica ediyorum bunu nasıl çalıştırabilirim

 

[muhasebeciyiz]

yazılan mesajlarınız A sutuna yazınız
1200 gr patates
1000 gr soğan
100 ml zeytinyağ

sonrasnda Alt+F11 tuşuna bas
verilen kodları oraya yapıştır
F5 tuşuna bas ve enterle çıkan sonucu gör
istersen bunu butona bağlayıp oradan çalıştır

https://dosya.co/uy7194etdv32/sebze_ayır.xlsm.html veya bu linkten indir

 

[Dogukan34]

çok teşekkür ederim gramaj kısmı hepsi geçti ancak ürün ismi yazan yerlerin bir çok kısmında bosluk oluştu

yazılan mesajlarınız A sutuna yazınız
1200 gr patates
1000 gr soğan
100 ml zeytinyağ

sonrasnda Alt+F11 tuşuna bas
verilen kodları oraya yapıştır
F5 tuşuna bas ve enterle çıkan sonucu gör
istersen bunu butona bağlayıp oradan çalıştır

https://dosya.co/uy7194etdv32/sebze_ayır.xlsm.html veya bu linkten indir

 

[muhasebeciyiz]

Sub Donustur()
    Dim cell As Range
    Dim value As String
    Dim number As Double
    Dim unit As String
    Dim product As String
    Dim parts() As String
    
    For Each cell In Range("A1:A3")
        value = cell.Value       
        
        parts = Split(value, " ")
        number = Val(parts(0))
        unit = parts(1)
        product = Join(Application.Index(parts, 0, 2), " ")
        
        cell.Offset(0, 1).Value = product
        cell.Offset(0, 2).Value = number & " " & unit
    Next cell
End Sub

Bu kodu deneyiniz

 

[Dogukan34]

maalesef bu seferde iki kelime olan ürünlerin sadece ilk kelimesini aktarıyor

 

[muhasebeciyiz]

Sub Donustur()
Dim cell As Range
Dim value As String
Dim number As Double
Dim unit As String
Dim product As String
Dim parts() As String
Dim i As Integer

For Each cell In Range("A1:A3")
value = cell.value
parts = Split(value, " ")

number = Val(parts(0))
unit = parts(1)


product = ""
For i = 2 To UBound(parts)
product = product & parts(i) & " "
Next i

product = Trim(product)

cell.Offset(0, 1).value = product
cell.Offset(0, 2).value = number & " " & unit
Next cell
End Sub

Deneyiniz