Excel 2007-セルに改行を追加し、50文字を超える行を追加しない

Excelのセルにメモを保存しています。新しいメモを追加するたびに、改行と日付を追加します。

これを別のプログラムにコピーする必要がありますが、行の制限は50文字です。新しい日付ごと、および各日付のコメントが50文字を超える場合に改行が必要です。

私はどちらか一方を行うことができますが、両方を行う方法がわかりません。単語が分割されないようにしたいのですが、この時点では気にしません。

以下は入力例です。=SUBSTITUTEまたは=REPLACE関数に必要な場合~は、入力の各日付の前に区切り文字としてaを追加できます。

サンプル入力：

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文字を追加して、別のワークシートに書き込むか、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文字の行のコレクションが返されます

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