Excel 2007 - 在单元格中添加换行符，不超过50个字符

我有笔记存储在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  

这里有一些东西可以用来将50个char增量放入一个集合对象中，您可以使用它来写出另一个工作表或写出csv或其他任何内容。Jsut迭代它并用内容做你想做的事

功能可以获得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个char行的集合

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脚本运行

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