遍历表列并根据数组在下一列中创建新值

Question

我有一个包含4列的表：

• ID
• 关键字
• 组件
• NewComponent

前三个包含数据，最后一个不包含数据。

我按关键字然后按组件对数据进行排序。

看下面的图片：

原始表：

预期结果：

据我所知，需要完成两个循环：

1. 通过关键字循环
2. 遍历关键字，遍历组件并创建新组件

这是我到目前为止的代码，但是我已经对所有循环感到困惑了。

    Sub SingleColumnTable_To_Array()

    Dim myTable As ListObject
    Dim myArray As Variant
    Dim x As Long
    Dim compArr() As String, kwArr(), newArr()

    Set tmpltWkbk = Workbooks("New DB.xlsm")
    Set ws1 = tmpltWkbk.Sheets("TableSheet")

    Set myTable = ws1.ListObjects("KW_Table")

    counterOne = 0

    myArray = myTable.DataBodyRange

    kwCounter = 1

    'keywords
    For y = LBound(myArray) To UBound(myArray)

        counterTwo = counterTwo + 1
        ReDim Preserve kwArr(counterTwo)
        kwArr(counterTwo) = myArray(y, 23)

    Next y

    RemoveDupesDict kwArr, newArr

    'components
    For x = LBound(myArray) To UBound(myArray)

        counterOne = counterOne + 1
        ReDim Preserve compArr(counterOne)
        compArr(counterOne) = myArray(x, 3)

    Next x

    For Each kwElement In newArr

        For Each compElement In compArr

            Counter = 1

            Do While kwCounter < Application.CountIf(kwArr, kwElement) + 1

                'This is how I imagine I would create the new component name
                'Selection.Offset(0, 1).Value = compElement & "." & Counter

                Counter = Counter + 1

                kwCounter = kwCounter + 1

            Loop

            End If

        Next compElement

    Next kwElement

End Sub

Answer 1

根据上面的评论。略微扩展代码以在表中添加新列，并在需要VBA解决方案的情况下插入公式：

Sub x()

Dim t As ListObject

Set t = Sheets(1).ListObjects("Table1")

t.ListColumns.Add
t.ListColumns(t.DataBodyRange.Columns.Count).DataBodyRange.Formula = "=C2&"".""&COUNTIFS($B$2:B2,B2,$C$2:C2,C2)"

End Sub