5選2排列組合

eric7765

請教大大 要如何圖片把 A1-A5 排列 如黃色區域這樣 一直排到欄位沒有資料為止 麻煩了

下載 (34.07 KB)

2021-3-10 05:47

jcchiang

回復 1# eric7765

資料擺放位置請自行調整
Sub ex()
Dim a As Object, X%, Y%
Y = 1
For Each a In Range([a1], [a1].End(4))
   For X = a.Row + 1 To [a1].End(4).Row
      Cells(Y, 3) = "[" & Format(Cells(a.Row, 1), "0#") & "." & Format(Cells(X, 1), "0#") & "]"  '資料放置於欄位(C)
      Y = Y + 1
   Next
Next
End Sub

eric7765

回復 2# jcchiang

eric7765

回復 3# eric7765
謝謝你 目前 可以使用  請問我目前把跑出來的放在 A7-A16 我要如何 把我所有的資料排列出來 目前 只能跑 A欄的數據 我想要一直跑到 欄位沒有資料為止

dou10801

回復 2# jcchiang 請教前輩,如果5選3,怎麼處理,謝謝.

jcchiang

回復 5# dou10801
5選2
Sub ex1()
Dim a As Object, b As Object, X%, Y%
Range([a7], [a7].End(4)).Clear
Y = 7
For Each a In [a1].CurrentRegion.Columns
   For Each b In a.Rows
      For X = b.Row + 1 To Cells(1, b.Column).End(4).Row
         Cells(Y, 1) = "[" & Format(Cells(b.Row, b.Column), "0#") & "." & Format(Cells(X, b.Column), "0#") & "]"
         Y = Y + 1
      Next
   Next
Next
End Sub

5選3
Sub ex2()
Dim a As Object, b As Object, X%, Y%
Range([a7], [a7].End(4)).Clear
Y = 7
For Each a In [a1].CurrentRegion.Columns
   For Each b In a.Rows
      For X = b.Row + 1 To Cells(1, b.Column).End(4).Row
         If X + 1 <= Cells(1, b.Column).End(4).Row Then
            Cells(Y, 1) = "[" & Format(Cells(b.Row, b.Column), "0#") & "." & Format(Cells(X, b.Column), "0#") & "." & Format(Cells(X + 1, b.Column), "0#") & "]"
            Y = Y + 1
         End If
      Next
   Next
Next
End Sub

eric7765

回復 6# jcchiang
J大 非常感謝你的幫忙 目前剩下一點小問題 我想要把 A1-A5的數據 排在A7-A16 B1-B5 排在 B7-B16 目前這個程式碼 會把所有的數據 一直在A欄排列 我想要呈現 數據在哪一欄 就排在那欄的下面 如果方便的話 再麻煩了

jcchiang

回復 7# eric7765

5選2
Sub ex1()
Dim a As Object, b As Object, X%, Y%
[a7].CurrentRegion.ClearContents
Y = 7
For Each a In [a1].CurrentRegion.Columns
   For Each b In a.Rows
      For X = b.Row + 1 To Cells(1, b.Column).End(4).Row
         Cells(Y, b.Column) = "[" & Format(Cells(b.Row, b.Column), "0#") & "." & Format(Cells(X, b.Column), "0#") & "]"
         Y = Y + 1
      Next
   Next
   Y = 7
Next
End Sub

5選3
Sub ex2()
Dim a As Object, b As Object, X%, Y%
[a7].CurrentRegion.ClearContents
Y = 7
For Each a In [a1].CurrentRegion.Columns
   For Each b In a.Rows
      For X = b.Row + 1 To Cells(1, b.Column).End(4).Row
         If X + 1 <= Cells(1, b.Column).End(4).Row Then
            Cells(Y, b.Column) = "[" & Format(Cells(b.Row, b.Column), "0#") & "." & Format(Cells(X, b.Column), "0#") & "." & Format(Cells(X + 1, b.Column), "0#") & "]"
            Y = Y + 1
         End If
      Next
   Next
   Y = 7
Next
End Sub

dou10801

回復 6# jcchiang 感謝jcchiang大大,收下慢慢學習.