|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Option Explicit
- Dim s, brr(), m%, k%, aa
- Sub 排列()
- Dim d, r%, arr, i%, x%
- Set d = CreateObject("Scripting.Dictionary")
- Columns("i:k") = ""
- r = Cells(Rows.Count, 1).End(xlUp).Row
- arr = Range("a2:b" & r)
- For i = 1 To UBound(arr)
- d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
- Next
- For Each aa In d.keys
- s = Split(d(aa), ",")
- m = UBound(s)
- If m > 1 Then
- x = Application.Permut(m, 2)
- ReDim brr(1 To x, 1 To 3): k = 0
- Call digui("", "", 0)
- r = Cells(Rows.Count, "i").End(xlUp).Row
- Cells(r + 1, "i").Resize(k, 3) = brr: Erase brr
- Else
- r = Cells(Rows.Count, "i").End(xlUp).Row
- Cells(r + 1, "i") = aa: Cells(r + 1, "j") = s(1)
- End If
- Next
- End Sub
- Sub digui(s1$, s2$, t%)
- Dim i%
- If t = 2 Then
- k = k + 1: brr(k, 1) = aa: brr(k, 2) = Split(s1, "|")(1): brr(k, 3) = Split(s1, "|")(2)
- Else
- For i = 1 To m
- If InStr(s2 & ",", "," & i & ",") = 0 Then
- Call digui(s1 & "|" & s(i), s2 & "," & i, t + 1)
- End If
- Next
- End If
- End Sub
复制代码 |
|