Hücredeki metni bölme

[airborne]

s.a.

sitede aşağıdaki hücredeki metni bölme ile ilgili kodları buldum. bu kodlar b1 den b10 kadar cümleyi 239 karakter bölecek şekilde revize edilebilir mi?

Selametle...............................

Private Sub CommandButton1_Click()
For I = 1 To 10

HUCRE1 = "": HUCRE2 = ""
   CUMLE = Cells(I, 1).Value               'cümle alınıyor
   If CUMLE = "" Then GoTo DEVAM
   HX = Mid(CUMLE, 1, 35)                  'Cümlenin İlk 35 harfi
   If Trim(Mid(HX, 35, 1)) = "" Then      'Boşluğa denk geldi
              HUCRE1 = Trim(HX)
              HUCRE2 = Trim(Mid(CUMLE, Len(HX) + 1, Len(CUMLE)))
      Else:
          
          For K = Len(HX) To 1 Step -1             'Boşluğa denk gelmedi
            If Trim(Mid(HX, K, 1)) = "" Then         'Geriye boşluk ara
              HUCRE1 = Trim(Mid(CUMLE, 1, K)) 
              HUCRE2 = Trim(Mid(CUMLE, K, Len(CUMLE)))
              GoTo DEVAM
             End If
          Next K
   End If
 
DEVAM:
Cells(I, 2).Value = HUCRE1
Cells(I, 3).Value = HUCRE2
Next I
End Sub

 

[Necdet]

Merhaba,

Hücre metni için örnek te verirseniz ve olması gerekeni de belirtirseniz ne demek istediğiniz daha rahat anlaşılacaktır.

 

[airborne]

s.a.

üstad örnek dosyayı ekledim. Sayfa1 a hücresindeki metni (bu metin daha da büyük olabilir)
b1 hücresinden b10 hücresine kadar 239 karakter veya küçük olarak bölmek için yukarıda ki makro nasıl revize edilebilir.

Örnek dosya

Selametle...........................

 

[Necdet]

Merhaba,
Aşağıdaki kodları dener misiniz?
Sadece A1 hücresindeki verileri böldürdüm, A sütununda veriler varsa döngüye sokulabilinir.

Public Sub MetinBol()

    Dim Metin As String
    
    Dim i As Integer
    Dim j As Integer
    
    Metin = Range("A1") & " "
    Range("B:B").ClearContents
    Do
        j = 239
        Do
            If Not Mid(Metin, j, 1) = " " Then j = j - 1
        Loop Until Mid(Metin, j, 1) = " " Or j = 0
        i = i + 1
        Cells(i, "B") = Left(Metin, j)
        Metin = Replace(Metin, Cells(i, "B"), "")
        
    Loop Until Len(Metin) = 0
    
End Sub

 

[airborne]

s.a.

Üstad Allah Razı olsun. 10 numara 5 yıldız çalışıyor.

 

[Necdet]

güle güle kullanınız.