- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
4#
發表於 2021-9-28 16:07
| 只看該作者
陣列數 2 個> 排列組合 3 個
陣列數 3 個> 排列組合 7 個
陣列數 4 個> 排列組合 15 個
陣列數 5 個> 排列組合 31 個
陣列數 6 個> 排列組合 63 個
歸納起來是 2 的 N次方個 (N是陣列數)
下列程式碼可排列出 陣列數 6 個> 排列組合 63 個
請教各位前輩 有辦法簡化並加到陣列數 100 個嗎?
謝謝指導!
Option Explicit
Sub TEST_20210928_1()
Dim i&, C&, Arr, Brr, x&
Arr = Array(1, 10, 100, 1000, 10000, 100000)
ReDim Brr(0 To 1000, 1)
C = 0
On Error Resume Next
For i = 0 To UBound(Arr)
Brr(C, 0) = Arr(i)
Brr(C, 1) = "單一"
C = C + 1
Next
For i = 0 To UBound(Arr)
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x)
Brr(C, 1) = "2個相加"
C = C + 1
End If
Next
Next
For i = 0 To UBound(Arr)
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 2)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 3)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 4)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 3)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 4)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 2) + Arr(x + 3)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 2) + Arr(x + 4)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "3個相加"
C = C + 1
End If
Next
Next
For i = 0 To UBound(Arr)
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 2)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 3)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 2) + Arr(x + 3)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 2) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "4個相加"
C = C + 1
End If
Next
Next
For i = 0 To UBound(Arr)
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x) + Arr(x + 1) + Arr(x + 2) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
For x = i To UBound(Arr)
If i <> x Then
Brr(C, 0) = Arr(i) + Arr(x + 1) + Arr(x + 2) + Arr(x + 3) + Arr(x + 4)
Brr(C, 1) = "5個相加"
C = C + 1
End If
Next
Next
Brr(C, 0) = Arr(0) + Arr(1) + Arr(2) + Arr(3) + Arr(4) + Arr(5)
Brr(C, 1) = "6個相加"
Workbooks.Add
[A1].Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)
[B1].Resize(UBound(Brr), 2) = Brr
[B:B].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns _
("E:E"), Unique:=True
[E:E].Sort _
KEY1:=[E1], Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke, _
DataOption1:=xlSortNormal
End Sub |
|