Question

我试图将长度大于72的单元格内容拆分成单独的行，其长度不超过72个字符。但我试图做的是如何重复每个单元格的序列号，同时将它们分成72个字符。例如，如果我在另一列中有一个具有144个字符和序列号S1的单元格，那么当我使用上述模块将文本分成2个单元格时，相同的序列号S1也会复制到创建的每个新单元格中。我们能做到吗？代码如下;

有什么建议吗？

Link to code

由于

Answer 1

一种简单的方法是创建一个在添加新单元格时递增的范围，然后在创建所有新单元格之后，运行该范围并根据需要附加序列号。因此，假设序列号在单元格（1,2）中（尽管可以轻松调整），请将其添加到原始处理循环中。

Dim finalRange As Range
Set finalRange = ActiveSheet.Range(Cells(1,2).Address)

'Now inside the loop:
Set finalRange = Union(finalRange,newCellLocation) ' where newCellLocation is where the next line of characters has been placed

'After the loop is complete
For Each cell In finalRange
If cell.Address <> ActiveSheet.Cells(1,2).Address Then
cell.value = ActiveSheet.cells(1,2).Value & ": " & cell.Value
'Note, adjust the string values to your desired format, this is just a placeholder
End If
Next Cell

Answer 2

现在您已经提供了输入数据和所需输出的示例，这是实现此目的的一种方法，修改先前提供的代码中的存储例程。

由于无法使用Redim保留更改第一个维度大小的数组，因此我们使用Collection对象收集所有单独的行，然后在单独的步骤中对结果数组进行大小和填充。

有些假设是源数据在sheet1列A：C上，第1行包含列标题，结果将写在sheet2上。

浏览代码并了解每一步的内容。提出问题以澄清为什么某种方式与另一种方式相同。

Option Explicit
Sub WordWrap2()
'requires reference to Microsoft VBScript Regular Expressions 5.5
'Wraps at W characters, but will allow overflow if a word is longer than W
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim str As String
Const W As Long = 72

Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant
Dim vRes() As Variant 'Results
Dim colLines As Collection
Dim vLine(1 To 3) As Variant 'to store each line in collection
Dim I As Long

'Set source to column A:C
'  A = Sequence
'  B = ID
'  C = TXLINE2
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

With wsSrc
    vSrc = .Range("A1", .Cells(.Rows.Count, "C").End(xlUp))
End With

Set RE = New RegExp
    RE.Global = True

    'Cycle through third column only, and collect the data
    Set colLines = New Collection
    For I = 1 To UBound(vSrc, 1)
        str = vSrc(I, 3)

        'remove all line feeds and nbsp
        RE.Pattern = "[\xA0\r\n\s]+"
        str = RE.Replace(str, " ")
        RE.Pattern = "\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"

        If RE.Test(str) = True Then
            Set MC = RE.Execute(str)

            'Collect the lines, along with Seq and ID
            For Each M In MC
                vLine(1) = vSrc(I, 1)
                vLine(2) = vSrc(I, 2)
                vLine(3) = M
                colLines.Add vLine
            Next M
        Else  'Allow preservation of blank lines in source data
            Erase vLine
            colLines.Add vLine
    End If
Next I

'create results array
ReDim vRes(1 To colLines.Count, 1 To 3)

'Note that column headers are carried over from source data

'Populate with the data
For I = 1 To colLines.Count
    vRes(I, 1) = colLines(I)(1)
    vRes(I, 2) = colLines(I)(2)
    vRes(I, 3) = colLines(I)(3)
Next I

Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

Set RE = Nothing
End Sub

在：

后：

将单元格内容划分为单独的行以及相应的列

2 个答案: