0

通过大量研究，我找到了一种代码，可以将存储在单元格中的句子截断为 100 个字符或更少，并将多余的句子添加到第二个字符串中。我一直在努力尝试把它变成一个函数。

我想让函数接受一个范围（1 列，不同的行），或者，如果不可能的话，一个具有相同范围值的数组。还应该有一种方法来设置每个输出字符串可以容纳的字符数，输出为字符串数组。

即 wordWrap(Input 'range or array', maxLength as integer) wordWrap 的输出将是结果的数组

这是我当前的代码：

Sub wordWrap()
'This procedure is intended to check the character length of a string and truncate all the words over 100 characters
'To a second string.  (basically a word wrap)

Dim sumCount As Integer, newCount As Integer, i As Integer
Dim newString As String, newString2 As String
Dim words As Variant
Dim lenwords(0 To 1000) As Variant
Dim myRange As Range
sumCount = 0
newCount = 0
newString = ""
newString2 = ""
With Range("Q:Q")
    .NumberFormat = "@"
End With
Set myRange = Range("B3")
words = Split(myRange.Value, " ")
For i = 0 To UBound(words)
    lenwords(i) = Len(words(i))
    Range("Q3").Offset(i, 0) = CStr(words(i)) 'DEBUG
    Range("R3").Offset(i, 0) = lenwords(i) 'DEBUG
    If sumCount + (lenwords(i) + 1) < 100 Then
        sumCount = sumCount + (lenwords(i) + 1)
        newString = newString & " " & words(i)
    Else
        newCount = newCount + (lenwords(i) + 1)
        newString2 = newString2 & " " & words(i)
    End If
Next
'DEBUG
Range("S3") = CStr(newString)
Range("T3") = Trim(CStr(newString2))
Range("S4") = Len(newString)
Range("T4") = Len(newString2)
ActiveSheet.UsedRange.Columns.AutoFit
End Sub

因此，如果以最多 100 个字符输入("B2:B6")或等效数组的范围：

c = wordWrap(Range("B2:B6"),100)

基本上这应该做的是计算每个单元格（或元素）的长度并截断任何使字符串超过 100 个字符的额外单词，并将它们连接到输出数组中下一个元素的前面到输出数组的下一个元素. 如果这会使该元素超过 100 个字符，那么再次执行相同的过程，直到所有元素都包含少于 100 个字符长的句子字符串。它应该在末尾添加一个额外的元素以适应任何剩余的单词。

我一直在扯我的头发试图让它发挥作用。我可以参考专家的建议。

任何帮助表示赞赏。

要求的示例：

http://s21.postimg.org/iywbgy307/trunc_ex.jpg

但是，输出应该是一个数组，而不是直接返回到工作表。

4

2 回答 2

2

功能：

Function WordWrap(ByVal Rng As Range, Optional ByVal MaxLength As Long = 100) As String()

    Dim rCell As Range
    Dim arrOutput() As String
    Dim sTemp As String
    Dim OutputIndex As Long
    Dim i As Long

    ReDim arrOutput(1 To Evaluate("CEILING(SUM(LEN(" & Rng.Address(External:=True) & "))," & MaxLength & ")/" & MaxLength) * 2)
    For Each rCell In Rng.Cells
        If Len(Trim(sTemp & " " & rCell.Text)) > MaxLength Then
            OutputIndex = OutputIndex + 1
            arrOutput(OutputIndex) = Trim(Left(sTemp & " " & rCell.Text, InStrRev(Left(sTemp & " " & rCell.Text, MaxLength), " ")))
            sTemp = Trim(Mid(sTemp & " " & rCell.Text, Len(arrOutput(OutputIndex)) + 2))
            For i = 1 To Len(sTemp) Step MaxLength
                If Len(sTemp) < MaxLength Then Exit For
                OutputIndex = OutputIndex + 1
                arrOutput(OutputIndex) = Trim(Left(sTemp, InStrRev(Left(sTemp, MaxLength), " ")))
                sTemp = Trim(Mid(sTemp, Len(arrOutput(OutputIndex)) + 2))
            Next i
        Else
            OutputIndex = OutputIndex + 1
            arrOutput(OutputIndex) = Trim(sTemp & " " & rCell.Text)
            sTemp = ""
        End If
    Next rCell
    OutputIndex = OutputIndex + 1
    arrOutput(OutputIndex) = sTemp

    ReDim Preserve arrOutput(1 To OutputIndex)
    WordWrap = arrOutput

    Erase arrOutput

End Function

来电：

Sub tgr()

    Dim arrWrapped() As String

    arrWrapped = WordWrap(Range("B2:B6"), 100)
    MsgBox Join(arrWrapped, Chr(10) & Chr(10))

End Sub

代替 msgbox，您可以将其输出到工作表，或者做任何您想做的事情。

于 2013-09-12T16:32:59.643 回答
1

会说你得到一个字符串，并想返回一个数组

这种方法的性能可能会很慢

dim words(1) as variant
dim lastSpace as Integer
dim i as Integer

words(1) = Cells(1, 1)

while(Len(words(UBound(words) - 1)) > 100) 'check if the newest array is > 100 characters
    Redim words(UBound(words) + 1)
    'find the last space
    for i = 0 to 100
        if(words(i) = " ") Then
            lastSpace = i
        EndIF
    Next
    words(UBound(words) - 1) = Mid(words(UBound(words) - 2), lastSpace) 'copy words after the last space before the 100th character
    words(UBound(words) - 2) = Left(words(UBound(words) - 2), 100 - lastSpace) 'copy the words from the beginning to the last space
Wend

不确定这是否会编译/运行，但它应该给你一个大致的想法

于 2013-09-12T16:44:33.653 回答