簡體   English   中英

文本到行VBA Excel

[英]Text to Rows VBA Excel

我有一個包含大約4000行數據的電子表格,其中一列數據具有唯一的訂單號,我想用“/”作為我的分隔符分隔。 基本上我想要:

Name      Order#       Date
Jane      123/001/111  08/15/2013
Gary      333/121      09/01/2013
Jack      222          09/02/2013

看起來像這樣:

Name      Order#       Date
Jane      123          08/15/2013
Jane      001          08/15/2013
Jane      111          08/15/2013
Gary      333          09/01/2013
Gary      121          09/01/2013
Jack      222          09/02/2013

我是VBA的新手,所以我決定嘗試谷歌尋找一個解決方案,在那里我找到了這段很好的代碼。

        Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    Dim ans 
    Dim Cels As Long, i As Long 
    Cancel = True 
    ans = Split(Target, ":") 
    Cels = UBound(ans) 
    Target.Offset(1).Resize(Cels).EntireRow.Insert shift:=xlDown 
    Rows(Target.Row).Copy Cells(Target.Row + 1, "A").Resize(Cels) 
    For i = 0 To Cels 
        Target.Offset(i) = ans(i) 
    Next 
End Sub

它工作得很好,但這個宏的功能是你必須雙擊行來分隔值。 我希望的是一種通過For循環傳遞此函數的方法,以便在整個電子表格中執行。

如果你的表看起來像這樣

在此輸入圖像描述

然后

Option Explicit

Sub Main()

    Columns("B:B").NumberFormat = "@"
    Dim i As Long, c As Long, r As Range, v As Variant

    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
        v = Split(Range("B" & i), "/")
        c = c + UBound(v) + 1
    Next i

    For i = 2 To c
        Set r = Range("B" & i)
        Dim arr As Variant
        arr = Split(r, "/")
        Dim j As Long
        r = arr(0)
        For j = 1 To UBound(arr)
            Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
            r.Offset(j, 0) = arr(j)
            r.Offset(j, -1) = r.Offset(0, -1)
            r.Offset(j, 1) = r.Offset(0, 1)
        Next j
    Next i

End Sub

會產生

在此輸入圖像描述

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM