拆分多行

Question

我在使用Excel和VBA时需要帮助。我对Excel / VBA几乎一无所知，并且我需要一个编码解决方案来帮助我避免手动执行这一繁琐的工作（想想需要解析的几百行在新表中一行可能变成多行的情况））。我一直在网上寻找解决方案，但是我一直对答案感到困惑（因为我对VB一无所知，并无法使用它在Excel中对宏进行编程），所以我想寻求帮助。具体问题。

这里是摘要：我有一个电子表格，需要在其中将行从源工作表复制到目标工作表。源工作表有两列（A和B），可以将其视为键/值对，其中col A包含键，而col B包含值。问题在于列B中的值。这些值可以是一行文本，也可以是不同文本的编号列表

我要针对源代码中的每一行：

将col B中的值拆分为每个值的数组（如果该值采用编号列表的形式）
通过遍历值的拆分数组在目标表中创建新行，以便在以下位置创建新行：新行col A =源行col A键，新行col B =拆分值数组中的当前迭代索引。
如果没有编号列表，只需将源行复制到目标表中

来源

A B key1 1. text1 2. text2 key2 1. text3

目标

A B key1 text1 key1 text2 key2 text3

一个单元格中的编号列表将是多行，其中每行文本前面都带有一个小数点和一个点。这也适用于单行单元格。

（更新）请记住，列A或B中的值不是简单的文本值。这些都是完整的句子。因此，我不确定一个简单的公式会起作用。

Answer 1

您可以使用两个公式进行操作。

我假设您的数据在Sheet1中。

对于第一列，请使用以下公式：

=IF(ISBLANK(Sheet1!A2),A1,Sheet1!A2)

第二种用途：

=IFERROR(RIGHT(Sheet1!B2,LEN(Sheet1!B2)-FIND(". ",Sheet1!B2)-1),Sheet1!B2)

然后填充。

编辑：

第一个公式将查看Sheet1, column A中的相应单元格。如果为空，它将采用公式所在位置上方的单元格的值。如果不为空，它将采用刚刚检查的Sheet1, column A中单元格的值。

第二个公式在". "的单元格中查找字符串Sheet1 column B，并从文本中删除字符串及其左侧的所有内容。如果找不到所讨论的字符串（". "）（意味着该给定单元格中没有编号），它将返回错误，因此整个内容将被包装在IFERROR语句中，该语句返回值Sheet1 column B中的单元格被触发。

Answer 2

拆分多行

目前尚不清楚在多行单元格中会出现哪个行分隔符。选择一个 vbLf 为我工作。

调整常量部分中的值以适合您的需求。

代码

Sub SplitMultiLine()

    Const cSheet1 As Variant = "Sheet1"   ' Source Worksheet Name/Index
    Const cFirstR As Integer = 1          ' Source First Row Number
    Const cFirstC As Variant = "A"        ' Source First Column Letter/Number
    Const cLastC As Variant = "C"         ' Source Last Column Letter/Number
    Const cMulti As Integer = 2           ' Multi Column
    Const cSplit As String = vbLf         ' Split Char(vbLf, vbCrLf, vbCr)
    Const cDot As String = "."            ' Dot Char (Delimiter)

    Const cSheet2 As Variant = "Sheet1"   ' Target Worksheet Name/Index
    Const cTarget As String = "E1"        ' Target First Cell Address

    Dim vntS As Variant       ' Source Array
    Dim vntSplit As Variant   ' Split Array
    Dim vntT As Variant       ' Target Array
    Dim lastR As Long         ' Source Last Row
    Dim i As Long             ' Source Array Row Counter
    Dim j As Integer          ' Source/Target Array Column Counter
    Dim k As Long             ' Target Array Row Counter
    Dim m As Integer          ' Split Array Row Counter

    ' Paste Source Range into Source Array.
    With Worksheets(cSheet1)
        lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
        vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
    End With

    ' Count the number of rows in target array.
    For i = 1 To UBound(vntS)
        k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
    Next

    ' Write from Source to Target Array.
    ReDim vntT(1 To k, 1 To UBound(vntS, 2))
    k = 0
    For i = 1 To UBound(vntS)
        k = k + 1
        vntSplit = Split(vntS(i, cMulti), cSplit)
        For m = 0 To UBound(vntSplit)
            If InStr(vntSplit(m), cDot) > 0 Then
                vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
                        - InStr(vntSplit(m), cDot)))
              Else
                vntT(k, cMulti) = vntSplit(m)
            End If
            For j = 1 To UBound(vntS, 2)
                If j <> cMulti Then
                    vntT(k, j) = vntS(i, j)
                End If
            Next
            k = k + 1
        Next
        k = k - 1
    Next

    ' Paste Target Array into Target Range calculated from Target Frist Cell.
    With Worksheets(cSheet2).Range(cTarget)
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub

评论过多

Sub SplitMultiLineOverCommented()

    Const cSheet1 As Variant = "Sheet1"   ' Source Worksheet Name/Index
    Const cFirstR As Integer = 1          ' Source First Row Number
    Const cFirstC As Variant = "A"        ' Source First Column Letter/Number
    Const cLastC As Variant = "C"         ' Source Last Column Letter/Number
    Const cMulti As Integer = 2           ' Multi Column
    Const cSplit As String = vbLf         ' Split Char(vbLf, vbCrLf, vbCr)
    Const cDot As String = "."            ' Dot Char (Delimiter)

    Const cSheet2 As Variant = "Sheet1"   ' Target Worksheet Name/Index
    Const cTarget As String = "E1"        ' Target First Cell Address

    Dim vntS As Variant       ' Source Array
    Dim vntSplit As Variant   ' Split Array
    Dim vntT As Variant       ' Target Array
    Dim lastR As Long         ' Source Last Row
    Dim i As Long             ' Source Array Row Counter
    Dim j As Integer          ' Source/Target Array Column Counter
    Dim k As Long             ' Target Array Row Counter
    Dim m As Integer          ' Split Array Row Counter

    ' Paste Source Range into Source Array.
    With Worksheets(cSheet1)
        ' The last row of data is usually calculated going from the bottom up,
        ' it is like selecting the last cell and pressing CTRL UP and returning
        ' =ROW() in Excel.
        lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
        ' Paste a range into an array actually means copying it. The array
        ' created is a 1-based 2-dimensional array which has the same number
        ' of rows and columns as the Source Range.
        vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
    End With

    ' Count the number of rows in Target Array.
    ' You refer to the last row of the array with UBound(vntS) which is short
    ' for UBound(vntS, 1) which reveals that it is referring to the first
    ' dimension (rows).
    For i = 1 To UBound(vntS)
        ' We are splitting the string by cSplit which is the line
        ' separator (delimiter). When you enter something into a cell and
        ' hold left Alt and press ENTER, the vbLf character is set in place
        ' of the line separator. But the data may have been imported from
        ' another system that uses another line separator. When splitting the
        ' string, a 0-based array is 'created' and its UBound is the last
        ' row, but since it is 0-based we have to add 1.
        k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
    Next

    ' Write from Source to Target Array.
    ' After we have calculated the number of rows, we have to resize the
    ' Target Array. To avoid confusion, I always use '1 To' to be certain that
    ' it is a 1-based array. Since the number columns of the Source Array and
    ' the Target Array is the same, we use the UBound of the Source Array to
    ' resize the second dimension of the Target Array - UBound(vntS, 2) where
    ' 2 is indicating the second dimension, columns.
    ReDim vntT(1 To k, 1 To UBound(vntS, 2))
    ' We will use again k as the row counter since its value is no more
    ' needed. This is what I have many times forgotten, so maybe it is
    ' better to use a different variable.
    k = 0
    ' Loop through the columns of Source Array.
    For i = 1 To UBound(vntS)
        ' Increase the row of Target Array or e.g. align it for writing.
        k = k + 1
        ' Split the string (lines) in the Multi Column into the 0-based
        ' Split Array.
        vntSplit = Split(vntS(i, cMulti), cSplit)
        ' Loop through the values of the Split Array
        For m = 0 To UBound(vntSplit)
            ' Check if value contains cDot. The Instr function returns 0 if
            ' a string has not been found, it's like =FIND(".",A1) in Excel,
            ' except that Excel would return an error if not found.
            If InStr(vntSplit(m), cDot) > 0 Then
                ' If cDot was found then write the right part after cDot
                ' to the current row of column cMulti but trim the result
                ' (remove space before and after.
                ' It's like =TRIM(RIGHT(A1,LEN(A1)-FIND(".",A1))) in Excel.
                vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
                        - InStr(vntSplit(m), cDot)))
              Else
                ' If cDot was not found then just write the value to the
                ' current row.
                vntT(k, cMulti) = vntSplit(m)
            End If
            ' Loop through all columns.
            For j = 1 To UBound(vntS, 2)
                If j <> cMulti Then
                    ' Write to other columns (Not cMulti)
                    vntT(k, j) = vntS(i, j)
                End If
            Next ' Next Source/Target Array Column
            ' Increase the current row of Target Array before going to next
            ' value in Split Array.
            k = k + 1
        Next ' Next Split Array Row
        ' Since we have increased the last current row but haven't written to
        ' it, we have to decrease one row because of the "k = k + 1" right below
        ' "For i = 1 To UBound(vntS)" which increases the row of Target Array
        ' for each next row in Source Array.
        k = k - 1
    Next ' Next Source Array Row

    ' Paste Target Array into Target Range calculated from Target Frist Cell.
    ' Like we pasted a range into an array, we can also paste an array into
    ' a range, but it has to be the same size as the array, so by using
    ' the Resize method we adjust the Target Range First Cell to the Target
    ' Range, using the last row and column of the Target Array. Again,
    ' remember UBound(vntT) is short for UBound(vntT, 1) (rows).
    With Worksheets(cSheet2).Range(cTarget)
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub

根据单元格拆分文本将工作表行复制到新工作表

2 个答案:

拆分多行

代码

评论过多