VBA，Parse by“|”和转置，下一行

Question

我在单元格A1中有以下数据

|stack|over|flow|

和细胞A2 ..

|today|is|friday

如何划分它并将其转换为基于垂直/列的视图？

分隔将给我数据行，这很好，但我必须每次手动转置它。我打算为很多行做这个。我意识到这可能很棘手，因为下一行需要每次都被推回。

结果A1：A6 ：

Stack

Over

flow

today

is

friday

修改

Answer 1

对于无限行和无限列：

Sub splt()
Dim str As String
Dim col As Long, rw As Long, colcnt As Long, rwcnt As Long
With Sheets("Sheet1")
    colcnt = .Cells(1, .Columns.Count).End(xlToLeft).Column 'total no of columns
    For col = 1 To colcnt
        rwcnt = .Cells(.Rows.Count, col).End(xlUp).Row 'total no of rows for specific column
        For rw = 1 To rwcnt
            str = str & .Cells(rw, col)
        Next rw

        rw = 1
        For Each Item In Split(str, "|") 'split string and display output
            If Item <> "" Then
                .Cells(rw, col) = Item
                rw = rw + 1
            End If
        Next
        str = ""
    Next
End With
End Sub

修改 您可以为此使用数组，但以下方法不易于编写和读取：

Sub splt()
Dim rw As Long, i As Long, rwcnt As Long
i = 1
With Sheets("Sheet1")
    rwcnt = .Cells(.Rows.Count, 2).End(xlUp).Row 'last non-empty row number
    For rw = 1 To rwcnt 'from row 1 till last non-empty row
        For Each Item In Split(.Cells(rw, 2), "|") 'split the string in column 2 from "|"
            If Item <> "" Then ' 'if the splitted part of the string is not empty
                .Cells(i, 4) = .Cells(rw, 1) 'populate column 4 with column 1
                .Cells(i, 5) = Item 'populate column 5 with splitted part of the string
                .Cells(i, 6) = .Cells(rw, 3) 'populate column 6 with column 3
                i = i + 1 ' increase i variable by one to be able to write the next empty row for the next loop
            End If
        Next 'loop to next splitted string
    Next rw 'loop to next row
    .Columns("A:C").EntireColumn.Delete 'when all data is extracted to Columns D-E-F, delete Columns A-B-C and your results will be in Column A-B-C now
End With
End Sub

Answer 2

这个在A列上管理无限数量的行

Sub go()

    Dim strFoo As String
    Dim LastRow As Long
    Dim LastPosition As Long
    Dim MySheet As Worksheet
    Dim arr() As String
    Dim i As Long
    Dim j As Long

    Set MySheet = ActiveWorkbook.ActiveSheet

    MySheet.Range("A1").EntireColumn.Insert

    LastRow = MySheet.Cells(MySheet.Rows.Count, "B").End(xlUp).Row

    LastPosition = 1

    For i = 1 To LastRow

        strFoo = MySheet.Range("B" & i)

        If strFoo <> "" Then

            arr = Split(strFoo, "|")

            For j = 0 To UBound(arr)
                If arr(j) <> "" Then
                    MySheet.Range("A" & LastPosition) = arr(j)
                    LastPosition = LastPosition + 1
                End If
            Next j

        End If

    Next i

End Sub

Answer 3

您可以使用 var main = function() { $(document).ready(function(){ $('ul').hide(); $('.recipe').click(function () { $('ul').toggle("slow"); }); }); }; $(document).ready(main); 或Power Query

执行此操作

• 数据 - ＆gt;得到＆amp;转换数据 - ＆gt;从表格/范围

然后在Get & Transform

• 按分隔符拆分列
  • 使用自定义分隔符：管道Query Editor
  • 最左边分裂（摆脱第一根管道
• 删除第1列（空白列）
• 按分隔符拆分列
  • 使用高级选项并选择拆分行

保存，你就完成了。