时间戳

首页 > 解决方案 > Excel - 如何根据不同列中的特定值将数据从列转换为行？

excel - Excel - 如何根据不同列中的特定值将数据从列转换为行？

问题描述

如果这是一个愚蠢的问题，我很抱歉，我对 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，但我相当确定我可以通过一些指导将值和单元格插入正确的位置，以防现有脚本的功能可以执行此操作

标签： excel

解决方案

看看这是否适合你。

您需要在工作簿中创建一个新工作表并将技术名称设置为shTransformed。通过进入 VBA 编辑器 (Alt + F11) 并更改它，如下所示...

如何更改工作表的技术名称

然后添加一个新模块（在 VBA 编辑器中，转到Insert->Module）并添加代码，如下所示...

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 编辑器中，转到Tools->References并添加参考...

Microsoft 脚本运行时

现在回到原始数据的工作表，全部选中，然后转到开发人员-> 宏（如果您在功能区中看不到开发人员菜单，请谷歌它。）并运行宏并查看它是如何运行的。

如果您查看转换后的工作表，您应该会看到结果。

结果

希望它对你有用。

推荐阅读