Excel-使用插入的行进行拆分和转置

在vba中我将使用什么代码来实现这一点，我一直在尝试将我在网上看到的其他代码改编为我的需要，但没有成功。我将非常感谢任何帮助

我以这种格式获取数据：

Col A   Col B  Col C  Col D
QBC       T    90125  LAK-912,323.YVS-PK,US.
QOL       T    53241  LWA-324.
QEF       F    31236  PKS-634,432,243.

我希望将数据提取为：

Col A   Col B  Col C  Col D
QBC       T    90125  LAK-912
QBC       T    90125  LAK-323
QBC       T    90125  YVS-PK
QBC       T    90125  YVS-US
QOL       T    53241  LWA-324
QEF       F    31236  PKS-634
QEF       F    31236  PKS-432
QEF       F    31236  PKS-243

---

希望它是清楚的

此子节点从单元格F2创建列表：

Dim LastRow As Long
Dim RowsOffset, ColsOffset, e, k As Long
Dim Str As String
Dim StrB, StrN As String
Dim Start As Long

Range("A1").Activate
LastRow = Range(ActiveCell.SpecialCells(xlLastCell).Address).Row

RowsOffset = 0
ColsOffset = 5
For e = 1 To LastRow
    Str = ActiveCell.Offset(e, 3).Value
    StrB = ""
    StrN = ""
    Start = 1
    For k = 1 To Len(Str)
        If Mid(Str, k, 1) = "," Then
            StrN = Mid(Str, Start, k - Start)
            Start = k + 1
            RowsOffset = RowsOffset + 1
            ActiveCell.Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 1).Value = ActiveCell.Offset(e, 1).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 2).Value = ActiveCell.Offset(e, 2).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 3).Value = StrB & StrN
        End If
        If Mid(Str, k, 1) = "." Then
            StrN = Mid(Str, Start, k - Start)
            Start = k + 1
            RowsOffset = RowsOffset + 1
            ActiveCell.Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 1).Value = ActiveCell.Offset(e, 1).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 2).Value = ActiveCell.Offset(e, 2).Value
            ActiveCell.Offset(RowsOffset, ColsOffset + 3).Value = StrB & StrN
        End If
        If Mid(Str, k, 1) = "-" Then
           StrB = Mid(Str, Start, k - Start + 1)
           Start = k + 1
        End If

    Next

如果您想要另一个职位，请更改：

RowsOffset = 0          ' Rows Offset
ColsOffset = 5          ' Column Offset

如果你想要另一张纸，代码会有点不同。您需要使用Activecell将8行更改为：

Sheets("Sheet2").Range("A1").Offset(RowsOffset, ColsOffset).Value = ActiveCell.Offset(e, 0).Value

函数的

SplitAndExpand（）

接受一个类似于原始“Col D”的字符串，并返回最终“Col D”中所需的字符串数组。从即时窗口修改并调用Test（）以检查函数：

    Public Function SplitAndExpand(ByVal Str As String) As String()

            Dim sdot()    As String
            Dim scomma()  As Variant
            Dim prefix    As String
            Dim result()  As String

            Dim i  As Long
            Dim j  As Long
            Dim n  As Long

            ' This code is NOT the most efficient.

            ' 1. Split the string at ".", ignore the last empty string
            Let sdot = Strings.Split(Str, ".")
            If sdot(UBound(sdot)) = "" Then
                    ReDim Preserve sdot(0 To (UBound(sdot) - 1))
            End If

            ' 2. For each sdot substring, split it at ","
            ReDim scomma(0 To UBound(sdot))
            Let n = 0
            For i = 0 To UBound(sdot)
                    ' Split
                    Let scomma(i) = Strings.Split(sdot(i), ",")

                    ' Cumulate results from this split
                    Let n = n + UBound(scomma(i)) + 1
            Next i

            ' 3. Build result from the prefix of the first scomma string and the
            '    rest of the strings. Result array is 1-based
            ReDim result(1 To n)
            Let n = 0
            For i = 0 To UBound(scomma)
                    ' Add the first entry and calculate prefix
                    Let n = n + 1
                    Let result(n) = scomma(i)(0)
                    Let prefix = Strings.Split(result(n), "-")(0) & "-"

                    ' Assemble the rest of the entries, and save them
                    For j = 1 To UBound(scomma(i))
                            Let n = n + 1
                            Let result(n) = prefix & scomma(i)(j)
                    Next j
            Next i

            ' 4. Return value
            Let SplitAndExpand = result

    End Function


    Public Sub Test()

            Dim a() As String
            Dim k As Long


            Let a = SplitAndExpand("LAK-912,323.YVS-PK,US.")
            For k = LBound(a) To UBound(a)
                    Debug.Print a(k)
            Next k

    End Sub

---

你会接受一个只处理“Col D”值拆分的答案，而把填充列的工作留给你吗？你的代码工作得很好，但我只希望你能做一个小小的编辑。为了处理一种情况，在给定的行中，Col D是空的，因此这里没有要拆分的内容，我希望在拆分和转置之后仍然可以看到该行。就目前情况而言，它没有显示任何东西。