Excel VBA satır sonu kodunda değer hatası

Question

Bu nedenle, bir metin bloğu alabilecek ve yalnızca satır başına en çok 50 karakter içerecek şekilde düzenleyen, ancak sözcükleri bir arada tutan bir program oluşturmaya çalışıyorum (bu şekilde değiştirme satır sonu karakteri için 50 karakter uzunluğunda bir metin satırındaki son boşluk ancak çıktı olarak bir değer hatası almaya devam ediyorum! İşte

bugüne kadar kodudur:

Option Explicit 

Public Function LnBrk50(selection) As String 

    Dim bookmark As Long 
    Dim step As Byte 
    Dim length As Byte 

'finds the last instance number of a space character in the text block within 50 characters 
    length = 50 - Len(WorksheetFunction.Substitute(Left(selection, 50), " ", "")) 
'replaces the last instance of a space character with a line break character 
     selection = WorksheetFunction.IfError(WorksheetFunction.Substitute(selection, " ", vbNewLine, length), selection) 
'character number of the last line break in the text block 
    bookmark = WorksheetFunction.Find(vbNewLine, selection) 

    step = 0 
    Do Until step = 9 
'finds the last instance number of a space character in the text block within the 50 characters after the last line break 
     length = 50 + bookmark - Len(WorksheetFunction.Substitute(Left(selection, 50 + bookmark), " ", "")) 
'replaces the space character found in last line with a line break character 
     selection = WorksheetFunction.IfError(WorksheetFunction.Substitute(selection, " ", vbNewLine, length), selection) 
'adds character number of the last line break 
     bookmark = WorksheetFunction.Find(vbNewLine, selection, bookmark + 1) 
     step = step + 1 
    Loop 

End Function 

kimse hangi hata Bunun # DEĞER üretecektir yapım olabilir bulabildiğim Yani eğer! tek bir başvurulan metin hücresinde kullanıldığında hata, çok takdir olurdu!

Answer 1

Bu ekran görüntüsü, A1 hücresinde çok uzun bir metin dizesi gösteriyor. Hücre A2

=LnBrk50(A1) 

Aşağıdaki kod LnBrk50 arkasında ne olduğunu içerir. Bunun yerine B1 modifiye metin hareketli A1 değiştirmek isterseniz

Option Explicit 

Public Function LnBrk50(ByRef selection As Variant) As String 

    Dim tempStr As String 
    Dim iLoc As Long, iEnd As Long 

    tempStr = selection.Value 
    If Len(tempStr) > 50 Then 
     iLoc = 0 
     Do While Len(tempStr) - iLoc > 50 
      iEnd = iLoc + 50 
      If Len(tempStr) < iEnd Then iEnd = Len(tempStr) 
      If Not InStrRev(tempStr, " ", iEnd) > 0 Then 
       iLoc = iLoc + 1 
      Else 
       iLoc = InStrRev(tempStr, " ", iEnd) 
       tempStr = Left(tempStr, iLoc - 1) & vbNewLine & Right(tempStr, Len(tempStr) - iLoc) 
      End If 
     Loop 
    End If 
    LnBrk50 = tempStr 

End Function 

, bir alt program kullanarak ve bir düğmeye ekleyerek yerine işlevini kullanarak öneriyoruz.

Answer 2

Eğer kod hakkında bu işlevi en hızlı olduğu ilginç olabilir

=LnBrk50(A1,50) 

olarak adlandırılan olacağını

Option Explicit 

Function LnBrk50(rng As Range, maxChar As Long) As String 

Dim strng2 As String, subStrng As String 
Dim arr As Variant 
Dim i As Long 

arr = Split(rng)  
i = 0 
Do While i < UBound(arr) 
    subStrng = arr(i) 
    Do While Len(subStrng) + 1 + Len(arr(i + 1)) <= maxChar 
     subStrng = subStrng + " " + arr(i + 1) 
     i = i + 1 
     If i = UBound(arr) Then Exit Do 
    Loop 
    strng2 = strng2 & subStrng & IIf(i < UBound(arr), vbCrLf, "") 
    i = i + 1 
Loop  
LnBrk50 = strng2 

End Function 

...