Excel 2007 - добавление разрывов строк в ячейку без строки длиной более 50 символов

Question

У меня есть заметки, хранящиеся в ячейке Excel. Я добавляю разрывы строк и даты каждый раз, когда добавляю новую заметку.

Мне нужно скопировать это в другую программу, но она имеет ограничение строки 50 символов. Я хочу разрыв строки для каждой новой даты и для каждого комментария к дате, превышающего 50 символов.

Я могу сделать одно или другое, но я не могу понять, как сделать оба. Я бы предпочел, чтобы слова не были разделены, но на данный момент мне все равно.

Ниже приведен пример ввода. При необходимости для функции =SUBSTITUTE или =REPLACE я мог бы добавить ~ перед каждой датой в своем входе в качестве разделителя.

Пример ввода:

07/03 - FU on query. Copies and history included. CC to Jane Doe and John Public  
06/29 - Cust claiming not to have these and wrong PO on query form. Responded with inv  sent dates and locations, correct PO values, and copies.  
06/27 - New ticket opened using query form  
06/12 - Opened ticket with helpdesk asking status  
05/21 - Copy submitted to customeremail@customer.com  
05/14 - Copy sent to John Public and email@customer.com  

Идеальный результат:

07/03 - FU on query. Copies and history included.  
CC to Jane Doe and John Public  
06/29 - Cust claiming not to have these and wrong  
PO on query form. Responded with inv sent dates an  
d locations, correct PO values, and copies.  
06/27 - New ticket opened using query form  
06/12 - Opened ticket with helpdesk asking status  
05/21 - Copy submitted to customeremail@customer.c  
om  
05/14 - Copy sent to John Public and email@custome  
r.com  

Answer 1

Вот кое-что, что вы можете использовать, чтобы поместить 50 приращений символов в объект коллекции, с помощью которого вы можете либо записать в другой лист, либо записать в CSV или что-то еще. Просто переберите его и сделайте то, что вы хотите, с содержимым

Функция для получения 50 или менее символов слов

Private Function FindFirst50ishChars(contents As String) As String
    Dim charSum As Integer, splitContents() As String, j As Integer
            Dim returnString As String: returnString = ""
        splitContents = Split(contents, " ")
        charSum = 0
            If Len(contents) <= 50 Then
                returnString = contents
            Else
                For j = LBound(splitContents) To UBound(splitContents)

                    If charSum + Len(splitContents(j)) >= 50 Then
                        Exit For
                    Else
                        returnString = returnString & " " & splitContents(j)
                        charSum = charSum + Len(splitContents(j)) + 1 '+1 for the extra space added
                        Debug.Print Len(returnString)
                    End If
                Next j
            End If
        FindFirst50ishChars = Trim(returnString)
End Function

Функция для перемещения по всему диапазону клеток. Вызовите эту функцию, и она вернет коллекцию ~ 50 символов

Function GetLinesIn50CharIncrements(StartRow As Integer, EndRow As Integer, Column As Integer) As Collection

    Dim row As Integer, j As Integer
    Dim aWs As Worksheet, contents As String
    Dim WholeLineConsumed As Boolean
    Set aWs = ActiveSheet
    Dim linesCollection As Collection: Set linesCollection = New Collection

    For row = StartRow To EndRow
        contents = aWs.Cells(row, Column)
        WholeLineConsumed = False
        Do While Not WholeLineConsumed
            Dim first50 As String
            first50 = FindFirst50ishChars(contents)
            linesCollection.Add first50
            contents = Right(contents, Len(Trim(contents)) - Len(first50))
            If contents = "" Then WholeLineConsumed = True
        Loop
    Next row
    Set GetLinesIn50CharIncrements = linesCollection
End Function

Редактировать:

Вы можете использовать это с помощью следующих нескольких строк. FileSystemObject требует, чтобы вы добавили ссылку на Microsoft Scripting Runtime

Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim FiftyCharLines As Collection: Set FiftyCharLines = GetLinesIn50CharIncrements(1, 6, 1)
Dim i As Integer, f As TextStream
Dim fileName As String: 'fileName = "some fully qualified file path"
Set f = fso.OpenTextFile(fileName, ForWriting, True)


For i = 1 To FiftyCharLines.Count
    f.WriteLine FiftyCharLines(i)
Next i
f.Close