求助

稍微麻点点，难度不大，增加辅助列1，为最大值判定，去最大值显示，2，再定位所有显示的最大值，增加行（你要几行加几行，按CTRL++号），3，复制想要贴的内容，再定位原内容，定位空白，粘贴！下课！

先函数处理一下，最后复制粘贴为值，合并相同单元格。

Option Explicit
Sub demo()
Dim arr, brr, result, i%, j%, n%
arr = Range("b1").CurrentRegion.Resize(, 1)
brr = Range("c1", Cells(Rows.Count, 3).End(3))
ReDim result(1 To UBound(arr) * UBound(brr), 1 To 2)
For i = 1 To UBound(arr)
For j = 1 To UBound(brr)
n = n + 1
result(n, 1) = arr(i, 1)
result(n, 2) = brr(j, 1)
Next j
Next i
[b1].Resize(UBound(result), 2) = result
For i = 1 To UBound(result) Step UBound(brr)
Cells(i, 2).Resize(UBound(brr)).Merge
Next i
End Sub

【合并后】

=HSTACK(TOCOL(EXPAND(B1:B3,,16,"")),REPTARRAY(C1:C16,COUNTA(B1:B3)))
今日功德抢回来

=IFNA(DROP(REDUCE(0,B1:B3,LAMBDA(x,y,VSTACK(x,HSTACK(y,C1:C16)))),1),"")

=TEXT({-1,1}%,TOCOL(HSTACK(C1&";"&B1:B3,TOROW(C2:C16)&Z1:Z3&";")))

(⊙﹏⊙)