将文本转换为行而不是文本转换为列

问题描述 投票:0回答:2

我有一个文本字符串,使用^符号作为分隔符。

我需要将文本分成新行而不是新列。

我需要创建新行以不覆盖它下面的下一行数据。

这可能不使用宏吗?我并不反对使用它,我只是不知道从哪里开始写它。

下面是一些示例数据的图片。顶部是如何列出的,底部(黄色)是我想要的。

在Windows 7 Pro上使用Excel 2010。

excel vba excel-2010
2个回答
0
投票

可以尝试这样的事情:

Sub reArrange()

    Dim inFirstRng As Range
    Dim inRng As Range
    Dim inCur As Variant
    Dim outFirstRng As Range
    Dim outCurRng As Range
    Dim ws As Worksheet

    'CHANGE ARGUMENT TO YOUR SHEET NAME
    Set ws = Worksheets("Sheet2")

    With ws
        'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA INPUT IS IN COLUMN A
        Set inFirstRng = .Range("A3")
        Set inRng = .Range(inFirstRng, inFirstRng.End(xlDown))
        'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA OUTPUT IS IN COLUMN A
        Set outFirstRng = .Range("A9")
        Set outCurRng = outFirstRng
    End With

    For Each cell In inRng.Cells

        inCur = WorksheetFunction.Transpose(Split(cell.Value, "^"))
        outCurRng.Resize(UBound(inCur), 1).Value = inCur

        With ws
            .Range("G" & outCurRng.Row & ":L" & outCurRng.Row).Value = _
            .Range("G" & cell.Row & ":L" & cell.Row).Value
        End With

        Set outCurRng = outCurRng.Offset(UBound(inCur), 0)

    Next cell

    ws.Range("F" & outFirstRng.Row & ":F" & outCurRng.Row - 1).Value = 1

End Sub

0
投票

感谢那些回应的人。一位朋友能够通过提供以下代码来提供帮助:

Sub Breakout()
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    For r = LR To 2 Step -1
        Set MyCell = Cells(r, 1)
        Arry = Split(MyCell.Value, "^")
        For c = 0 To UBound(Arry)
            If c > 0 Then MyCell.Offset(c, 0).EntireRow.Insert
            MyCell.Offset(c, 0) = Arry(c)
        Next c
    Next r
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.