Question

我有一个包含组和用户名的Excel文档，格式如下：

Group1          user1
                user2
                user3
Group2          user2
                user4
Group3          user5

etc.etc。每个组都是一行，所有用户都是单元格内的多行条目。

我需要它采用单行格式，因此我可以将其导出为CSV并使用它做一些有用的事情。

我不关心它如何被转换（excel热键，python脚本，等等），但它需要看起来像：

Group1         user1
Group1         user2
Group1         user3
Group2         user2
Group2         user4
Group3         user5

Answer 1

不确定我应该回答我自己的问题，但是同事能够提供答案。

使用VBS我能够创建一个专门完成我需要的模块。代码如下，其中iColumn变量是包含多行数据的列。

代码的信用转到http://excel.tips.net/T003263_Splitting_Information_into_Rows.html

Sub CellSplitter1()
    Dim Temp As Variant
    Dim CText As String
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
    Dim iColumn As Integer
    Dim lNumCols As Long
    Dim lNumRows As Long

    iColumn = 2

    Set wksSource = ActiveSheet
    Set wksNew = Worksheets.Add

    iTargetRow = 0
    With wksSource
        lNumCols = .Range("IV1").End(xlToLeft).Column
        lNumRows = .Range("A65536").End(xlUp).Row
        For J = 1 To lNumRows
            CText = .Cells(J, iColumn).Value
            Temp = Split(CText, Chr(10))
            For K = 0 To UBound(Temp)
                iTargetRow = iTargetRow + 1
                For L = 1 To lNumCols
                    If L <> iColumn Then
                        wksNew.Cells(iTargetRow, L) _
                          = .Cells(J, L)
                    Else
                        wksNew.Cells(iTargetRow, L) _
                          = Temp(K)
                    End If
                Next L
            Next K
        Next J
    End With
End Sub

Answer 2

除非我误解了任务，否则完成工作的代码可以简单得多。这应该有效：

Sub ungrouper()

    'Assumes that users column does not contain blank cells.

    Dim users() As Variant
    Dim groups() As Variant
    Dim rngUsers As Range
    Dim rngGroups As Range

    Dim j As Integer
    Dim k As Integer

    'Change Column to match layout of your workbook.
    Set rngUsers = Range("B1", Range("B1").End(xlDown))
    users = rngUsers

    j = 1
    k = 1

    'Change column offset to match the layout of your workbook.
    Set rngGroups = rngUsers.Offset(0, -1)
    groups = rngGroups

    Do While j <= UBound(users)
        If groups(j, 1) = Empty Then
            groups(j, 1) = groups(j - 1, 1)
        End If
        j = j + 1
    Loop

    rngGroups.Value = groups

End Sub

将多行Excel组转换为单独的行

2 个答案: