将逗号分隔的值拆分为excel中的行

时间:2017-09-18 18:10:06

标签: excel-vba excel-2010 vba excel

这是我的数据: Orig data

使用方法Data-> Text to columns-> Transpose在这种情况下不起作用。我需要将逗号分隔值转换为每个单独的行,并将其他列数据重复以匹配。就像一个SQL表。也许有一个宏可以做到这一点。

以下是我想要的结果: Desired result

1 个答案:

答案 0 :(得分:1)

我无法看到您的屏幕截图,但我认为这个概念适合您。

Option Explicit

'Qual coluna possui os termos que repetem?
Const ANALYSIS_ROW As String = "K"

'Em qual linha começam os dados?
Const DATA_START_ROW As Long = 2

Sub ReplicateData()
    Dim iRow As Long
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        .Worksheets("Sheet1").Copy After:=.Worksheets("Sheet1")
        Set ws = ActiveSheet
    End With

    With ws
        LastRow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = LastRow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")
        iSize = UBound(iSplit) - LBound(iSplit) + 1
        If iSize = 1 Then GoTo Continue

        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
相关问题