Excel 转置虚拟变量

我想转换一个excel文件的结构，这样我就可以将它导入到一个需要以给定方式对其进行结构化的系统中

下面是excel文件的一个小摘录。分类变量（如业务线）和四个虚拟变量（指示给定流程中使用了哪些数据类别，如客户）的组合

我想要的是更改结构，以便为伪变量的每个变体创建一个新行，并使用一个应用/转换相关数据类别名称的数据类别列。所需的输出如下所示：

| Process name | Line of business | Data category      |
|--------------|------------------|--------------------|
| Ad campaign  | Marketing        | Customer           |
| Ad campaign  | Marketing        | Potential customer |
| Ad campaign  | Marketing        | Vendor             |
| Payroll      | HR               | Employee           |
| Payroll      | HR               | Vendor             |

我尝试的是制作一个COUNTIF语句，计算每行的“x”数。然后，我使用了一个vba脚本，该脚本创建了一个新行，其中包含每个数据类别变体的进程名称。 这是代码，脚本中的字母表示excel中的列，因此A是进程名称列，G是COUNTIF列，它创建了我需要的n行数

Sub KopyKat()
   Dim N As Long, i As Long, K As Long
   Dim v As String, kk As Long, m As Long
   N = Cells(Rows.Count, "G").End(xlUp).Row
   K = 1

   For i = 2 To N
      kk = Cells(i, "G").Value
      v = Cells(i, "A").Value
      For m = 1 To kk
         Cells(K + 1, "H") = v
         K = K + 1
      Next m
   Next i
End Sub

所以它是这样的：

| Process name | Line of business | Customer | Potential customer | Employee | Vendor | COUNTIF |
|--------------|------------------|----------|--------------------|----------|--------|---------|
| Ad campaign  | Marketing        | x        | x                  |          | x      | 3       |
| Payroll      | HR               |          |                    | x        | x      | 2       |

为此：

| Process name | Line of business | Customer | Potential customer | Employee | Vendor | COUNTIF | Process name_2 |
|--------------|------------------|----------|--------------------|----------|--------|---------|----------------|
| Ad campaign  | Marketing        | x        | x                  |          | x      | 3       | Ad campaign    |
| Payroll      | HR               |          |                    | x        | x      | 2       | Ad campaign    |
|              |                  |          |                    |          |        |         | Ad campaign    |
|              |                  |          |                    |          |        |         | Payroll        |
|              |                  |          |                    |          |        |         | Payroll        |

这就是我有限的vba知识带给我的。我想更改代码，以便获得所需的输出。

---

提前谢谢

检查此代码并根据您的需要进行自定义：

基于此数据布局：

---

如果这有帮助，请记住标记答案。首先，我推荐Power Query for data这种数据操作

其次，如果必须这样做，我认为将数据放在实际的Excel表中对于组织数据和编写代码更好

无论如何，下面你可以找到我的解决方案。根据输入列的数量，可以调整内部循环

注意：逐单元格循环不是最有效的方法。如果数据量很大，将值读入数组并在内存中更改它们将使计算速度提高100倍以上。如果您能提供有关数据大小的更多信息，我可以相应地更新我的答案

Option Explicit

Sub KopyKat()
    Dim totalRow As Long
    totalRow = Cells(Rows.Count, "A").End(xlUp).Row

    'Result and data input sheets are specified here.
    Dim wsInput As Worksheet:     Set wsInput = Worksheets("Sheet5")
    Dim wsOutput As Worksheet:     Set wsOutput = Worksheets("Sheet6")

    Dim i As Long 'Row
    Dim j As Long 'Column
    Dim counter As Long:    counter = 0

   For i = 2 To totalRow
      For j = 3 To 6 'Column numbers are hardcoded for the sake of the example

      'Assumption is that value "x" is the only way to specify
        If wsInput.Cells(i, j).Value = "x" Then
            With wsOutput
                .Cells(counter + 2, 1) = wsInput.Cells(i, 1).Value 'Process Name
                .Cells(counter + 2, 2) = wsInput.Cells(i, 2).Value 'Line of Business
                .Cells(counter + 2, 3) = wsInput.Cells(1, j).Value 'Data Category
            End With
          counter = counter + 1
        End If

      Next j
   Next i
End Sub

---

只需使用Power Query（Excel 2010+中提供）即可完成 所有步骤都可以从UI中完成，但M代码如下

编辑：添加了重命名属性的步骤

• 从表/范围中获取数据
• 选择前两列，然后取消选择其他列
• 过滤值列以仅显示x
• 删除值列
• 重命名属性列-->

  数据类别

M码

---

非常感谢努里！正如您所指出的，考虑到数据集的巨大规模，在Power中执行此查询对我来说是最有效的。非常感谢Ricardo！这管用！正如我通过Ron的回答发现的那样，对于没有vba编码经验的人来说，在PowerQuery中这样做是最有效和最直观的。太棒了！按照您在问题中的要求，我提供了VBA解决方案。PowerQuery是一个很好的选择！

Sub Transpose()

    Dim evalSheet As Worksheet
    Dim evalRange As Range
    Dim headerRange As Range
    Dim evalCell As Range
    Dim destCell As Range

    Dim sheetName As String
    Dim sourceRangeAddress As String
    Dim headerRangeAddress As String
    Dim destinationCellAddress As String

    Dim rowCounter As Long

    ' Customize to fit your needs
    sheetName = "Sheet1"
    sourceRangeAddress = "A2:F3"
    headerRangeAddress = "A1:F1"
    destinationCellAddress = "I2"

    Set evalSheet = ThisWorkbook.Worksheets(sheetName )

    ' Get the range
    Set evalRange = evalSheet.Range(sourceRangeAddress)

    Set headerRange = evalSheet.Range(headerRangeAddress)

    Set destCell = evalSheet.Range(destinationCellAddress)

    ' Loop through each cell in the first column
    For Each evalCell In evalRange.Columns(1).Cells

        ' Evaluate the four columns (columnOffset means how many columns to the right)
        If Trim(evalCell.Offset(columnOffset:=2).Value) = "x" Then
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
            ' Header range cells (3) means the third cell in the range - different than offset
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(3).Value)

            rowCounter = rowCounter + 1

        End If

        If Trim(evalCell.Offset(columnOffset:=3).Value) = "x" Then
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(4).Value)

            rowCounter = rowCounter + 1
        End If
        If Trim(evalCell.Offset(columnOffset:=4).Value) = "x" Then
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(5).Value)

            rowCounter = rowCounter + 1
        End If
        If Trim(evalCell.Offset(columnOffset:=5).Value) = "x" Then
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=0).Value = Trim(evalCell.Offset(columnOffset:=0).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=1).Value = Trim(evalCell.Offset(columnOffset:=1).Value)
            destCell.Offset(rowOffset:=rowCounter, columnOffset:=2).Value = Trim(headerRange.Cells(6).Value)

            rowCounter = rowCounter + 1
        End If
    Next evalCell

End Sub

Option Explicit

Sub KopyKat()
    Dim totalRow As Long
    totalRow = Cells(Rows.Count, "A").End(xlUp).Row

    'Result and data input sheets are specified here.
    Dim wsInput As Worksheet:     Set wsInput = Worksheets("Sheet5")
    Dim wsOutput As Worksheet:     Set wsOutput = Worksheets("Sheet6")

    Dim i As Long 'Row
    Dim j As Long 'Column
    Dim counter As Long:    counter = 0

   For i = 2 To totalRow
      For j = 3 To 6 'Column numbers are hardcoded for the sake of the example

      'Assumption is that value "x" is the only way to specify
        If wsInput.Cells(i, j).Value = "x" Then
            With wsOutput
                .Cells(counter + 2, 1) = wsInput.Cells(i, 1).Value 'Process Name
                .Cells(counter + 2, 2) = wsInput.Cells(i, 2).Value 'Line of Business
                .Cells(counter + 2, 3) = wsInput.Cells(1, j).Value 'Data Category
            End With
          counter = counter + 1
        End If

      Next j
   Next i
End Sub

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Process name", type text}, {"Line of business", type text}, {"Customer", type text}, {"Potential customer", type text}, {"Employee", type text}, {"Vendor", type text}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Process name", "Line of business"}, "Attribute", "Value"),
    #"Filtered Rows" = Table.SelectRows(#"Unpivoted Other Columns", each ([Value] = "x")),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Value"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Attribute", "Data Category"}})
in
    #"Renamed Columns"