Разделить текст на 80 символьных строк, проблема с последней строкой - PullRequest
0 голосов
/ 01 августа 2020

Я пытаюсь взять основной текст и добавить разрывы строк примерно по 80 символов в каждой строке. Проблема, с которой я столкнулся, заключается в последней строке, в которой добавляется дополнительный разрыв строки, чем хотелось бы. Например, в этой строке не должно быть разрывов на предпоследней строке:

Alice was beginning to get very tired of sitting by her sister on the bank, and 
of having nothing to do: once or twice she had peeped into the book her sister 
was reading, but it had no pictures or conversations in it, and what is the use 
of a book, thought Alice without pictures or 
conversations?

должно выглядеть так (обратите внимание, что «разговоры» перемещены вверх):

Alice was beginning to get very tired of sitting by her sister on the bank, and 
of having nothing to do: once or twice she had peeped into the book her sister 
was reading, but it had no pictures or conversations in it, and what is the use 
of a book, thought Alice without pictures or conversations?

Вот код:

Sub StringChop()

Dim OrigString As String
Dim NewString As String
Dim counter As Long
Dim length As Long
Dim LastSpace As Long
Dim LineBreak As Long
Dim TempString As String
Dim TempNum As Long

OrigString = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, and what is the use of a book, thought Alice without pictures or conversations?"

length = Len(OrigString)
counter = 1
    
    Do While counter < length

        'Extract next 80 characters from last position
        TempString = Mid(OrigString, counter, 80)

        'Determine last space in string
        LastSpace = InStrRev(TempString, " ")

        'Determine first line break in string
        LineBreak = InStr(TempString, vbNewLine)

    'If line break exists in sentence...
      'only count characters up to line break, and set counter to that amount

        Select Case LastSpace   'What to do if there are spaces in sentence

            Case Is > 0     'There are spaces in sentence

                Select Case LineBreak   'What to do if there are line breaks in sentence

                    Case Is = 0

                        'From last counter position,
                        NewString = NewString & Mid(OrigString, counter, LastSpace) & vbNewLine

                        counter = counter + LastSpace

                    Case Is <> 0

                        NewString = NewString & Mid(OrigString, counter, LineBreak)
                        counter = counter + LineBreak
                End Select

            Case Is = 0     'There are no more spaces left in remaining sentence

                NewString = NewString & Mid(OrigString, counter)
                counter = length
        End Select
    Loop

Debug.Print NewString

End Sub

1 Ответ

0 голосов
/ 02 августа 2020

Перенос слов - интересная проблема. Я однажды написал следующий код в качестве эксперимента. Вы можете найти это полезным:

Option Explicit

'Implements a dynamic programming approach to word wrap
'assumes fixed-width font
'a word is defined to be a white-space delimited string which contains no
'whitespace
'the cost of a line is the square of the number of blank spaces at the end
'of a line

Const INFINITY As Long = 1000000
Dim optimalCost As Long

Function Cost(words As Variant, i As Long, j As Long, L As Long) As Long
'words is a 0-based array of strings, assumed to have no white spaces
'i, j are indices in range 0,...,n, where n is UBOUND(words)+1
'L is the maximum length of a line
'Cost returns the cost of a line which begins with words(i) and ends with
'words(j-1). It returns INFINITY if the line is too short to hold the words
'or if j <= i
    Dim k As Long
    Dim sum As Long
    If j <= i Or Len(words(i)) > L Then
        Cost = INFINITY
        Exit Function
    End If
    sum = Len(words(i))
    k = i + 1
    Do While k < j And sum <= L
        sum = sum + 1 + Len(words(k)) 'for space
        k = k + 1
    Loop
    If sum > L Then
        Cost = INFINITY
    Else
        Cost = (L - sum) ^ 2
    End If
End Function

Function WordWrap(words As Variant, L As Long) As String
'returns string consisting of words with spaces and
'line breaks inserted at the appropriate places

    Dim v() As Long, d() As Long
    Dim n As Long
    Dim i As Long, j As Long
    Dim candidate As Long
    
    n = UBound(words) + 1
    ReDim v(0 To n)
    ReDim d(0 To n)
    v(0) = 0
    d(0) = -1
    For j = 1 To n
        v(j) = INFINITY 'until something better is found
        i = j - 1
        Do
            candidate = v(i) + Cost(words, i, j, L)
            If candidate < v(j) Then
                v(j) = candidate
                d(j) = i
            End If
            i = i - 1
        Loop While i >= 0 And candidate < INFINITY
        If v(j) = INFINITY Then
            MsgBox "Some words are too long for the given length"
            Exit Function
        End If
    Next j
    optimalCost = v(n)
    'at this stage, optimal path has been found
    'just need to follow d() backwards, inserting line breaks
    i = d(n) 'beginning of current line
    WordWrap = words(n - 1)
    j = n - 2
    Do While i >= 0
        Do While j >= i
            WordWrap = words(j) & " " & WordWrap
            j = j - 1
        Loop
        If i > 0 Then WordWrap = vbCrLf & WordWrap
        i = d(i)
    Loop
End Function

Вышеупомянутая функция ожидает массив слов. Вам нужно будет разделить строку, прежде чем использовать ее в качестве ввода:

Sub test()
    Dim OrigString As String
    OrigString = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do: once or twice she had peeped into the book her sister was reading, but it had no pictures or conversations in it, and what is the use of a book, thought Alice without pictures or conversations?"
    Debug.Print WordWrap(Split(OrigString), 80)
End Sub

Вывод:

Alice was beginning to get very tired of sitting by her sister on the bank, 
and of having nothing to do: once or twice she had peeped into the book 
her sister was reading, but it had no pictures or conversations in it, and 
what is the use of a book, thought Alice without pictures or conversations?
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...