试试这个

Sub CreatePairs()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

Dim i As Long, j As Long
Dim cat As String, item1 As String, item2 As String
Dim currentRow As Long
currentRow = 1

For i = 2 To lastRow
cat = ws.Cells(i, 1).Value
item1 = ws.Cells(i, 2).Value

For j = i + 1 To lastRow
    If ws.Cells(j, 1).Value = cat Then
        item2 = ws.Cells(j, 2).Value
        currentRow = currentRow + 1
        ws.Cells(currentRow, 3) = cat
        ws.Cells(currentRow, 4) = item1
        ws.Cells(currentRow, 5) = item2
    End If
Next j

Next i

End Sub

使用Excel 365计算公式：

=LET(
    category, A2:A8,
    item, B2:B8,
    DROP(
        REDUCE(
            {1, 1, 1},
            UNIQUE(category),
            LAMBDA(a, b,
                LET(
                    count, SUM(
                        --(
                            b =
                                category
                        )
                    ),
                    combos, COMBIN(
                        count,
                        2
                    ),
                    start, XMATCH(
                        b,
                        category
                    ) - 1,
                    ind, TOCOL(
                        MAKEARRAY(
                            count,
                            count,
                            LAMBDA(
                                r,
                                c,
                                IF(
                                    c >
                                        r,
                                    100 *
                                        r +
                                        c,
                                    0
                                )
                            )
                        )
                    ),
                    sel, FILTER(
                        ind,
                        ind > 0
                    ),
                    VSTACK(
                        a,
                        HSTACK(
                            IF(
                                SEQUENCE(
                                    combos
                                ),
                                b
                            ),
                            INDEX(
                                item,
                                sel /
                                    100 +
                                    start
                            ),
                            INDEX(
                                item,
                                MOD(
                                    sel,
                                    100
                                ) +
                                    start
                            )
                        )
                    )
                )
            )
        ),
        1
    )
)

基本思想是获取二维数组上三角形部分的行和列，并使用它来索引每个组的项目，因此，如果一个组中有三个项目：

1,1 1,2 1,3
2,1 2,2 2,3
3,1 3,2 3,3

使用1，2，1，3和2，3。