这尽可能使用数组,从而限制访问工作表的次数
Sub mygrouping()
With Worksheets("Sheet6") ' change to your sheet
Dim rngA As Variant
rngA = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value
Dim rngOthers As Variant
ReDim rngOthers(1 To Application.CountA(.Range("B1", .Cells(1040000, .Cells(1, .Columns.Count).End(xlToLeft).Column)))) As Variant
Dim j As Long, k As Long, i As Long
k = 1
For j = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
rngintm = .Range(.Cells(1, j), .Cells(.Rows.Count, j).End(xlUp)).Value
For i = 1 To UBound(rngintm, 1)
If rngintm(i, 1) <> "" Then
rngOthers(k) = rngintm(i, 1)
k = k + 1
End If
Next i
Next j
Dim outarr() As Variant
ReDim outarr(1 To UBound(rngA, 1) * UBound(rngOthers), 1 To 1)
k = 1
For i = 1 To UBound(rngA, 1)
For j = 1 To UBound(rngOthers)
outarr(k, 1) = rngA(i, 1) & rngOthers(j)
k = k + 1
Next j
Next i
'Outputs to another sheet change to your sheet name and desired location
Worksheets("Sheet7").Range("A1").Resize(UBound(outarr, 1), 1).Value = outarr
End With
End Sub