Excel - Как я могу преобразовать данные из столбцов в строки на основе определенного значения в другом столбце?

Question

Извините, если это глупый вопрос, у меня довольно элементарное понимание более сложных функций Excel.По сути, я работаю с данными пациентов и натолкнулся на препятствие, потому что наша система управления данными экспортирует в формате, который отличается от того, что мне нужно.Мы говорим о том, что я сомневаюсь, возможно ли то, что мне нужно, (Примечание: DoS - это дата обслуживания).Вот что у меня есть:

Acct#    DoS           Wt.    Ht.     Lab
12345    01/02/2019    143    62.5    5.8      
12345    04/027/2019   144    62.3    4.6      
14345    01/06/2019    167    57.3    6.8      
14345    02/03/2019    172    57.7    6.7
14345    02/15/2019    174    57.6    6.6   

Я понятия не имею, как преобразовать данные, но мне нужно, чтобы они в конечном итоге были отформатированы как:

Acct#   DoS_1     Wt.  Ht.   Lab   DoS_2       Wt.    Ht.     Lab.   DoS_3     Wt.
12345   01/02/19  143  62.5  5.8   04/27/2019  144    62.3    4.6      -        -  
14345   01/06/19  167  57.3  6.8   02/03/2019  172    57.7    6.7   02/15/19   174

Есть некоторые номера счетов, которые будут толькоесть одна встреча.Есть другие, у которых может быть два или даже двенадцать.Я понятия не имею, как использовать VBA, но я вполне уверен, что смогу подключить значения и ячейки в нужном месте с некоторыми рекомендациями, если есть функция существующего сценария, которая может выполнить это действие

Answer 1

Посмотрите, работает ли это для вас.

Вам необходимо создать новый рабочий лист в вашей рабочей книге и установить техническое имя на shTransformed . Сделайте это, зайдя в редактор VBA (Alt + F11) и изменив его, как показано ниже ...

Затем добавьте новый модуль (в редакторе VBA перейдите на Вставка-> Модуль ) и добавьте код, как показано ниже ...

Public Sub TransformToColumnsByAcct()
    Dim rngSrcData As Range, i As Long, objDict As Scripting.Dictionary, strKey As String, arrRows As Variant
    Dim lngHeaderStartCol As Long, x As Long, lngSrcRow As Long, lngWriteRow As Long, lngMaxUbound As Long

    Set rngSrcData = Selection
    Set objDict = New Scripting.Dictionary

    With rngSrcData
        ' Get all of the unique accounts, this will also determine for us the amount of columns we need to provide for.
        ' Start from the 2nd row because the 1st contains the header.
        For i = 2 To .Rows.Count
            strKey = .Cells(i, 1)

            If Not objDict.Exists(strKey) Then
                objDict.Add strKey, Array(i)
            Else
                arrRows = objDict.Item(strKey)
                ReDim Preserve arrRows(UBound(arrRows) + 1)
                arrRows(UBound(arrRows)) = i

                objDict.Item(strKey) = arrRows

                If UBound(arrRows) > lngMaxUbound Then
                    lngMaxUbound = UBound(arrRows)
                End If
            End If
        Next

        ' Clear all of the cells in the destination worksheet.
        shTransformed.Cells.Clear

        ' Add the header for the key field.
        shTransformed.Cells(1, 1) = .Cells(1, 1)

        lngHeaderStartCol = 2

        ' Now get all of the column headers excluding the first as this contains the key and write them to the
        ' transformed worksheet.  Dynamically increment the 2nd header by 1 each time.
        For i = 1 To lngMaxUbound + 1
            ' Determine the start column for the header to be copied to factoring in the first field.
            If i > 1 Then
                lngHeaderStartCol = lngHeaderStartCol + .Columns.Count - 1
            End If

            .Range(.Cells(1, 2).Address & ":" & .Cells(1, .Columns.Count).Address).Copy shTransformed.Cells(1, lngHeaderStartCol)

            ' Incremement the header text by 1 and put an underscore.
            shTransformed.Cells(1, lngHeaderStartCol) = shTransformed.Cells(1, lngHeaderStartCol) & "_" & i
        Next

        ' Now write out all of the unique keys to the transformed sheet along with the data.
        For i = 0 To objDict.Count - 1
            strKey = objDict.Keys(i)
            arrRows = objDict.Item(strKey)

            lngWriteRow = i + 2

            ' Write the key to the first column.
            shTransformed.Cells(lngWriteRow, 1) = strKey

            lngHeaderStartCol = 2

            ' Now process each row of data for the unique key.
            For x = 0 To UBound(arrRows)
                lngSrcRow = arrRows(x)

                If x > 0 Then
                    lngHeaderStartCol = lngHeaderStartCol + .Columns.Count - 1
                End If

                ' Copy the data for the given row to the transformed sheet.
                .Range(.Cells(lngSrcRow, 2).Address & ":" & .Cells(lngSrcRow, .Columns.Count).Address).Copy shTransformed.Cells(lngWriteRow, lngHeaderStartCol)
            Next
        Next
    End With
End Sub

Далее в редакторе VBA перейдите на Инструменты-> Ссылки и добавьте ссылку ...

Microsoft Scripting Runtime

Теперь вернитесь на свой лист с необработанными данными, выберите все и перейдите к Разработчик-> Макросы (Если вы не видите меню разработчика на своей ленте, найдите его в Google). запустите макрос и посмотрите, как он работает.

Если вы посмотрите на преобразованный лист, вы должны увидеть свой результат.

Вот надеемся, что это сработает для вас.