6 kelimeden sonrakini yan sütuna yazdırma VBA makro

[cevoreyiz]

Arkadaşlar merhaba

Benim bir excel formumda N bölümünde adres kayıtları var ama bunlar 60 karaktarden uzun olduğu için atıcağım program kabul etmiyor adres 1 adres 2 olarak bölmemi istiyor yani N bölümünde 60 karakter dolduktan sonra devamını O bölümüne yazsın istiyorum. Ama O dan dışarı taşmasın yani sadece N ve O hücrelerinde adres yazsın VA macro ile bunu yapmam gerekiyor ama ne yaptıysam başaramadım yardımcı olabilir misiniz.

 

[YUSUF44]

Eğer N hücresine yazı yazıldığında bu değişikliğin olmasını istiyorsanız aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N:N]) Is Nothing Then Exit Sub
If Target <> "" Then
    If Len(Target) > 60 Then
        Application.EnableEvents = False
        Target.Offset(0, 1) = Right(Target, Len(Target) - 60)
        Target = Left(Target, 60)
        Application.EnableEvents = True
    End If
End If
End Sub

 

[YUSUF44]

Eğer mevcut verilerinizi değiştirmek istiyorsanız aşağıdaki kodları bir modüle kopyalayıp deneyiniz. N sütunundaki tüm dolu hücreleri kontrol eder ve 60 karakterden uzun olanları O sütununa böler:

Sub ayır()
For i = 1 To Cells(Rows.Count, "N").End(3).Row
    If Len(Cells(i, "N")) > 60 Then
        Cells(i, "O") = Right(Cells(i, "N"), Len(Cells(i, "N")) - 60)
        Cells(i, "N") = Left(Cells(i, "N"), 60)
    End If
Next
End Sub

 

[askm]

Aşağıdaki kod ile 6. kelimeden öncesini B sütununa sonrasını C sutununa yazar.
(Bu arada formda kod bloğu nasıl yazıldığını bilmediğim için yazdığım kodlar bazen farklı karakterlerde çıkıyor. Kusuruma bakmayın.)

Sub ayir1()
Dim kelime As String
Dim önceki As String
Dim sonraki As String
For i = 2 To Cells(Rows.Count, "A").End(3).Row
kelime = Split(Cells(i, 1), " ")(6)
onceki = Split(Cells(i, 1), kelime)(0)
Cells(i, 2).Value = onceki
sonraki = Right(Cells(i, 1), Len(Cells(i, 1)) - Len(Cells(i, 2)))
Cells(i, 3).Value = sonraki
Next
End Sub

 

[YUSUF44]

(Bu arada formda kod bloğu nasıl yazıldığını bilmediğim için yazdığım kodlar bazen farklı karakterlerde çıkıyor. Kusuruma bakmayın.)

Kod tagı için kod bloğuna alacağınız metni seçin ve hemen üstteki # düğmesine basın. Seçtiğiniz metnin başına [ code] sonuna [ /code] ekler (boşluklar hariç tabi, ben koda dönüştürmesin diye fazladan boşluk yaptım) ve kod düzeninde görüntüler.

 

[cevoreyiz]

Eğer mevcut verilerinizi değiştirmek istiyorsanız aşağıdaki kodları bir modüle kopyalayıp deneyiniz. N sütunundaki tüm dolu hücreleri kontrol eder ve 60 karakterden uzun olanları O sütununa böler:

Sub ayır()
For i = 1 To Cells(Rows.Count, "N").End(3).Row
    If Len(Cells(i, "N")) > 60 Then
        Cells(i, "O") = Right(Cells(i, "N"), Len(Cells(i, "N")) - 60)
        Cells(i, "N") = Left(Cells(i, "N"), 60)
    End If
Next
End Sub

Öncelikle teşekkür ederim fakat kod mismatch hatası veriyor

 

[YUSUF44]

Ben deneyerek vermiştim. Herhangi bir hata vermedi. HAtalı haliyle imzamdaki gibi paylaşabilir misiniz?

 

[cevoreyiz]

Ben deneyerek vermiştim. Herhangi bir hata vermedi. HAtalı haliyle imzamdaki gibi paylaşabilir misiniz?

http://s5.dosya.tc/server3/o5iaws/cevo.rar.html

Merhabalar yükledim dosyamı kusura bakmayın geç cevap verdim. İlginiz için teşekkür ederim. Mismatch hatası veriyor ama yinede ayırmayı yapıyor. Bir de bu ayırma işlemini kelime olarak yaptıramaz mıyız acaba 60 karakterden sonrasını harf harf ayırıyor meselea

İstanbul kelimesini N sütununa İstan O sütununa bul şeklinde geçiriyor. Teşeküürler

 

[YUSUF44]

O hatayı vermesinin sebebi 300. satırda #YOK hatası olması. O satırı ya da o hücredeki veriyi silerseniz hata vermediğini göreceksiniz.

İlk mesajınızda 60 karakterden sonrasını aktarmasını istemiştiniz. Ben de ona göre kodu düzenlemiştim. Kelime olarak bölmek biraz karışık.

Bunun için önce 60 karakterden önceki son boşluğu bulmak gerekiyor. Eğer bu boşluktan sonraki karakterler 60'tan fazlaysa ne olacağı da önemli. Bu ayarlamayı yapabileceğimi sanmıyorum maalesef.

 

[YUSUF44]

Aslında çok basit bir mantıkla yapılabilirmiş Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub ayır()
For i = 1 To Cells(Rows.Count, "N").End(3).Row
    If Len(Cells(i, "N")) > 60 Then
        For j = 60 To 1 Step -1
            If Mid(Cells(i, "N"), j, 1) = " " Then
                Cells(i, "O") = Trim(Right(Cells(i, "N"), Len(Cells(i, "N")) - j))
                Cells(i, "N") = Trim(Left(Cells(i, "N"), j))
                j = 1
            End If
        Next
    End If
Next
End Sub