在EXCEL中将1列内容(逗号分隔)拆分为多行

时间:2013-08-02 13:43:41

标签: excel-vba excel-formula vba excel

我有一些数据如下,

UserID  | UserName  | skills | 
1       | John      | 1,2,3,4,5|     
2       | Mary      | 1,2,3|   

任何人都可以帮助我使用可以将数据结构更改为:

的宏
UserID  | UserName  | skills | 
1       | John      | 1 |  
1       | John      | 2 |  
1       | John      | 3 | 
1       | John      | 4 | 
1       | John      | 5 |  
2       | Mary      | 1 |     
2       | Mary      | 2 |
2       | Mary      | 3 |   

谢谢!

3 个答案:

答案 0 :(得分:1)

您可以在Excel中使用text to columns功能。

请参阅此链接: Microsoft Support

答案 1 :(得分:1)

我只有一分钟时间为您制作此代码。以下评论中的一些额外假设。

Sub qTest()
'assumptions:
'1. you need to select top left cell of your original data table, _
    i.e. cell UserId
'2. table will be created to the right- there must be empty area

'select UserID cell
    Dim i As Long
    Dim tmpSkills As Variant
    Dim tmpRow As Long
    Dim iSkills As Long
    Dim tmpArray As Variant
        tmpArray = Selection.CurrentRegion

'copying
    Selection.Resize(1, 3).Copy Selection.Offset(0, 4)

    For i = 2 To UBound(tmpArray)

        tmpSkills = Split(tmpArray(i, 3), ",")
        iSkills = UBound(tmpSkills) +1

        'skils        
        Selection.Offset(1 + tmpRow, 6).Resize(iSkills, 1) = Application.Transpose(tmpSkills)
        'UserId
        Selection.Offset(1 + tmpRow, 5).Resize(iSkills, 1) = tmpArray(i, 2)
        'UserName
        Selection.Offset(1 + tmpRow, 4).Resize(iSkills, 1) = tmpArray(i, 1)

        tmpRow = tmpRow + iSkills

    Next
End Sub

图片显示之前(左侧)和之后(右侧)的数据。在运行宏之前,应选择UserID cell

enter image description here

答案 2 :(得分:0)

此方法查看每一行,然后插入行并将信息传播到位,覆盖。但我觉得我更喜欢KazJaw。

enter image description here

enter image description here

Sub Spread_Skills()
'Spread string of skills down spreadsheet for each UserID
'Application.ScreenUpdating = False 'Uncomment for large files
    i = 2
    Do While Not IsEmpty(Cells(i, 1)) 'as long as there is a userid do this
        If Not InStr(Cells(i, 3), ",") = 0 Then 'if there is a comma, more than one skill, do this
            UserId = Cells(i, 1) 'gather info
            UserName = Cells(i, 2) 'gather info
            adn = Len(Cells(i, 3)) - Len(Application.WorksheetFunction.Substitute(Cells(i, 3), ",", "")) 'count number of skills
            Rows(i + 1 & ":" & i + adn).Select 'go to the next row
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Insert a row for each skill-1
            temp = Mid(Cells(i, 3), Application.WorksheetFunction.Find(",", Cells(i, 3), 1) + 1, Len(Cells(i, 3))) 'asign string of skills
            Cells(i, 3) = Left(Cells(i, 3), Application.WorksheetFunction.Find(",", Cells(i, 3), 1) - 1) 'make the first row the first skill
            For o = i + 1 To i + adn 'for each additional skill do this
                If Not InStr(temp, ",") = 0 Then 'if it isn't the last skill do this
                    ntemp = Left(temp, Application.WorksheetFunction.Find(",", temp, 1) - 1) 'slice
                    temp = Mid(temp, Application.WorksheetFunction.Find(",", temp, 1) + 1, Len(temp)) 'reasign remaining skills
                Else: 'if it is the last skill do this
                    ntemp = temp
                End If
                Cells(o, 1) = UserId 'enter data
                Cells(o, 2) = UserName 'enter data
                Cells(o, 3) = ntemp 'enter data
                Next o 'next row in skill range
        End If
        i = i + adn + 1 'go to the next userid
    Loop
'Application.ScreenUpdating = true 'Uncomment for large files
End Sub