- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2015-9-14 09:59
| 只看該作者
回復 1# q1a2z5
試試看- Option Explicit
- Sub Ex() '數字的重排
- Dim w As String, i As Single, t As Single
- Dim ww As String, Ar(), Arr(), At(), tt As Single
- w = 66654422 '指定數字
- t = Application.WorksheetFunction.Fact(Len(w)) 'Fact(工作表函數):數字的階乘。某數的階乘等於 1*2*3*...* 數字
- '*******************************************
- t = t / 3 '666重複
- t = t / 2 '44重複
- t = t / 2 '22重複
- t = t / 3 '2,4,6重複
- '*******************************************
- ReDim At(1 To t) ' '設立重新排列的總數的陣列
- ReDim Ar(1 To Len(w))
- For i = 1 To Len(w)
- Ar(i) = Mid(w, i, 1) '數字指定到陣列中
- Next
- '**********************************
- For i = 1 To UBound(At)
- ww = "" '清空
- Do
- Randomize '初始化亂數產生器
- Arr = Ar 'Ar(數字指定的陣列)置入 Arr
- Do
- tt = Int(((Len(w)) * Rnd) + 1) '亂數
- If Arr(tt) <> "" Then
- ww = ww & Arr(tt)
- Arr(tt) = "" '清空
- End If
- Loop Until Len(Join(Arr, "")) = 0 'Arr 全部清空
- If InStr("," & Join(At, ",") & ",", "," & ww & ",") Then '數字存在"重新排列的總數的陣列
- ww = ""
- Else
- At(i) = ww
- Exit Do
- End If
- Loop
- Next
- [a1].Resize(t) = Application.WorksheetFunction.Transpose(At)
- End Sub
複製代碼 |
|