metni hücrelere bölme

[incsoft]

Arkadaşlar barkod programım için lazım olan bir işlemim var ama bunu yapamadım.Metinleri Sütunlara dönüştürme ile oluyor ancak bu işlemi çok sık yapacağım için hızlı olmasıda önemli.A1 hücresinde 920902çDTS140280ç225886 olduğunu varsayalım.Benim isteğim B1 hücresine 920902 C1 hücresine DTS140280 D1 hücresine ise 225886 yazmasını istiyorum.Bunu 1 butona kod olarak atayacağım ve gerektiği zaman tıklayıp otomatik atamasını yaptıracağım.Bu konuda yardımcı olmanızı arz ederim.

İyi çalışmalar.

 

[NBATMAN]

Merhaba,

kodlar aşağıdaki gibidir.

Private Sub CommandButton1_Click()
 Dim bol As Variant
     
    bol = Split(Range("A1").Value, "ç")
    Range("B1").Value = bol(0)
     Range("C1").Value = bol(1)
      Range("D1").Value = bol(2)
End Sub

 

[Mustafa MUTLU]

Kodu denermisiniz
Bir modüle kaydedin
Düğmeye HUCRELERIAYIR kodunu atayın.

Sub HUCRELERIAYIR()

    Dim a
    Dim i       As Long
    Dim j       As Integer
    Dim Ad      As String
    Dim Soyad   As String
    Dim AdSoy   As String
    
    Application.ScreenUpdating = False
Range("B2:E65536").ClearContents
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
    
        AdSoy = Trim(Cells(i, "A"))
        Ad = ""
        Soyad = ""
        a = Split(AdSoy, "ç")
 
            For j = 0 To UBound(a) - 1
              Ad = Trim(Ad & " " & a(j))
              Cells(i, "E") = Ad
            Next j
            Soyad = Trim(a(UBound(a)))

        Cells(i, "D") = Soyad

    Next i
Call SIRALA2
    Application.ScreenUpdating = True
    
    MsgBox "Ad ve Soyad Ayrılmıştır...", vbInformation, "www.excel.web.tr"
Range("E2:E65536").ClearContents
End Sub

Sub SIRALA2()

    Dim a
    Dim i       As Long
    Dim j       As Integer
    Dim Ad      As String
    Dim Soyad   As String
    Dim AdSoy   As String
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "E").End(3).Row
    
        AdSoy = Trim(Cells(i, "E"))
        Ad = ""
        Soyad = ""
        a = Split(AdSoy, " ")
        
        If UBound(a) = 0 Then
            Ad = Trim(AdSoy)
        Else
            For j = 0 To UBound(a) - 1
                Ad = Trim(Ad & " " & a(j))
            Next j
            Soyad = Trim(a(UBound(a)))
        End If
    
        Cells(i, "B") = Ad
        Cells(i, "C") = Soyad
    
    Next i

    Application.ScreenUpdating = True
    

End Sub

 

[Sarigol_937]

Buda benden olsun makro bilmediğim için fonksiyonlarla yaptım dosya ektedir

 

[Sarigol_937]

siz barkod kodu yazınca veya yapıştırınca anında 3 sütüna bölcek

 

[ZorBey_]

Merhaba iyi çalışmalar
Sayın incsoft
Örnek dosyayı denermisiniz.
http://s3.dosya.tc/server17/yytHDM/Ay_rData.rar.html