我已经复制了一些代码 . 只要每列中有两行以上，它就可以正常工作 . 如果只有一行，则返回值“”，而不是该列中的第一个也是唯一的值 . 我可以让它上班吗？
Sub ListCombinations()
Dim col As New Collection Dim c As Range，sht As Worksheet，res Dim i As Long，arr，numCols As Long Dim numCol As Integer Dim Col_Cnt As Integer Dim Rows_Cnt As Integer Set sht = Worksheets（“Sheet5”）Col_Cnt = sht . UsedRange.Columns.Count'添加Rows_Cnt = sht.UsedRange.Rows.Count'添加
For Each c In sht.Range("A1:B1").Cells
col.add Application.Transpose(sht.Range(c, c.End(xlDown)))
numCols = numCols + 1
MsgBox "numCols = " & numCols
Next c
res = Combine(col, "~~")
For i = 0 To UBound(res)
arr = Split(res(i), "~~")
sht.Range("H1").Offset(i, 0).Resize(1, numCols) = arr
Next i
结束子
'从字符串数组的集合创建组合函数组合（作为集合，作为字符串的字符串）作为字符串（）
Dim rv() As String
Dim pos() As Long, lengths() As Long, lbs() As Long, ubs() As Long
Dim t As Long, i As Long, n As Long, ub As Long
Dim numIn As Long, s As String, r As Long
numIn = col.Count
MsgBox numIn
ReDim pos(1 To numIn)
ReDim lbs(1 To numIn)
ReDim ubs(1 To numIn)
ReDim lengths(1 To numIn)
t = 0
For i = 1 To numIn 'calculate # of combinations, and cache bounds/lengths
lbs(i) = LBound(col(i))
ubs(i) = UBound(col(i))
lengths(i) = (ubs(i) - lbs(i)) + 1
pos(i) = lbs(i)
t = IIf(t = 0, lengths(i), t * lengths(i))
Next i
ReDim rv(0 To t - 1) 'resize destination array
For n = 0 To (t - 1)
s = ""
For i = 1 To numIn
s = s & IIf(Len(s) > 0, SEP, "") & col(i)(pos(i)) 'build the string
Next i
rv(n) = s
For i = numIn To 1 Step -1
If pos(i) <> ubs(i) Then 'Not done all of this array yet...
pos(i) = pos(i) + 1 'Increment array index
For r = i + 1 To numIn 'Reset all the indexes
pos(r) = lbs(r) ' of the later arrays
Next r
Exit For
End If
Next i
Next n
Combine = rv
结束功能