Question

我将在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

希望很清楚！

Answer 1

此子目录从单元格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

Answer 2

SplitAndExpand()函数采用类似于原始＆＃34; Col D＆＃34;的字符串。并在最终的＆＃34; Col D＆＃34;中返回所需的字符串数组。修改并从立即窗口调用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

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

2 个答案: