Макрос Excel для преобразования отношения один-один в один-много

Question

У меня есть два столбца - один - Имя группы, а другой - пользователь, который выглядит примерно так:

Мне нужно преобразовать это впоказать все группы в виде заголовков столбцов и всех пользователей в соответствующей группе следующим образом:

Макрос предназначен для запуска большого количества групп безтакой лимит на количество пользователей.Если существует 100 групп, макрос должен создать 100 столбцов и перечислить пользователей в соответствующих группах.

Answer 1

Для целей этого ответа данные, включенные в Лист1 и отдельные в Группы в Листе 2.

Попробуйте:

Option Explicit

Sub test()

    Dim LR As Long
    Dim GroupName As String
    Dim LC As Long
    Dim i As Long
    Dim j As Long
    Dim LC2 As Long
    Dim LR2 As Long
    Dim Exist As Boolean

    LC = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
    LR = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

    For i = 2 To LR
        Exist = True
        GroupName = Sheet1.Cells(i, 1).Value

        If LC = 1 And Sheet2.Cells(1, 1).Value = "" Then
            Sheet2.Cells(1, 1).Value = GroupName
            Sheet2.Cells(1, 1).Offset(2, 0).Value = Sheet1.Cells(i, 2).Value
        Else
            LC2 = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column
            For j = 1 To LC2
                If GroupName = Sheet2.Cells(1, j).Value Then
                    LR2 = Sheet2.Cells(Rows.Count, j).End(xlUp).Row
                    Sheet2.Cells(LR2 + 1, j).Value = Sheet1.Cells(i, 2).Value
                    Exist = True
                    Exit For
                Else
                   Exist = False
                End If
            Next j
            If Exist = False Then
                Sheet2.Cells(1, LC2 + 1).Value = GroupName
                Sheet2.Cells(1, LC2 + 1).Offset(2, 0).Value = Sheet1.Cells(i, 2).Value
            End If
        End If

    Next i

End Sub

Answer 2

1. Убедитесь, что исходные данные отсортированы по GroupName.
2. Выполните цикл по всем строкам данных.
3. Каждый раз, когда изменяется GroupName, переходите в новый столбец и пишите заголовок
4. Запись пользователя в текущий столбец назначения

Вот пример:

Option Explicit

Public Sub ConvertData()
    Dim wsSrc As Worksheet
    Set wsSrc = ThisWorkbook.Worksheets("DataSource")

    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("DataOutput")

    'sort data by GroupName
    With wsSrc.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A:B")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Dim LastRow As Long 'find last used row in column A
    LastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    Dim CurrentGroup As String

    Dim DestCol As Long, DestRow As Long 'counters for destination column and row
    DestCol = 0 'destination column

    Dim iRow As Long
    For iRow = 2 To LastRow 'loop through all data rows
        If wsSrc.Cells(iRow, 1).Value <> CurrentGroup Then 'if GroupName changed …
            CurrentGroup = wsSrc.Cells(iRow, 1).Value 'remember new group name
            DestCol = DestCol + 1 'move destination 1 column further
            DestRow = 1 'start at the top in this new column
            wsDest.Cells(DestRow, DestCol).Value = CurrentGroup 'write header (GroupName) of new group into the column
        End If

        'write user …
        DestRow = DestRow + 1 'move to the next free row
        wsDest.Cells(DestRow, DestCol).Value = wsSrc.Cells(iRow, 2).Value
    Next iRow
End Sub