如何在距我所在的单元格X列数的单元格中写入(X是另一个单元格中定义的值)

时间:2019-04-05 05:27:09

标签: excel excel-formula

我有一组项目,分类为A/B/C。例如:

项目和类别:

enter image description here

我想将A / B / C列为一列,但将每个项目都放在整个范围内。例如:

每个项目作为列:

enter image description here

每个类别下可以有任意数量的项目时,该怎么办?

我认为宏可以做到这一点,但我希望能尽可能地避开宏。

1 个答案:

答案 0 :(得分:0)

修改代码,然后尝试:

Option Explicit

Sub TEST()

    Dim LastRow As Long, LastColumn As Long, LastColumn2 As Long, i As Long, y As Long
    Dim arr As Variant

    With ThisWorkbook.Worksheets("Sheet1")

        arr = Array("A", "B", "C") '<- Create an array with the desirable Items

        For i = LBound(arr) To UBound(arr) '<- Loop array
            'Find Last column of row 12 in order to import Titles
            LastColumn = .Cells(12, .Columns.Count).End(xlToLeft).Column

            If LastColumn = 1 And .Cells(11, LastColumn).Value = "" Then
                .Cells(11, LastColumn).Value = arr(i)
            Else
                .Cells(11, LastColumn + 1).Value = arr(i)
            End If
            'Find Last row of column B in order to create the loop range
            LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            'Loop column B from 1 to last row of column B
            For y = 1 To LastRow
                'Check if looping value is the same with array value
                If .Range("B" & y).Value = arr(i) Then
                    'Find Last column of row 12 in order to import values
                    LastColumn2 = .Cells(12, .Columns.Count).End(xlToLeft).Column

                    If LastColumn2 = 1 And .Cells(12, LastColumn2).Value = "" Then
                        .Cells(12, 1).Value = .Range("A" & y).Value
                    Else
                        .Cells(12, LastColumn2 + 1).Value = .Range("A" & y).Value
                    End If

                End If

            Next y

        Next i

    End With

End Sub

结果:

enter image description here