- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-11-25
|
本帖最後由 Andy2483 於 2025-11-24 15:54 編輯
回復 1# hcm19522
謝謝前輩分享此主題,後學藉此帖練習亂數產生練習成績排名資料,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Z, A, B, i&, j%, T, x%
Set A = [A3].Resize(30, 26): A.Interior.ColorIndex = xlNone
Application.Volatile: T = Int(Rnd() * 10) + 1
With A
.Columns(1) = "=""學生"" & ROW()-2"
.Columns(2) = "=""G2"" & TEXT(" & T & ",""00"")"
For j = 7 To 23 Step 4
.Columns(j) = "=ROUND(RAND()*60+40,0)+INT(RAND()*2)*0.5"
With .Columns(j).Resize(, 5)
.Columns(5) = "=ROW()-2": .Value = .Value
.Sort KEY1:=.Item(1), Order1:=2, Header:=2
.Columns(2) = "=ROW()-2"
.Columns(3) = "=" & .Cells(0, 3).Address(0, 0) & "+INT(RAND()*30+1)"
.Cells(1, 3) = "=INT(RAND()*30+1)+" & .Cells(1, 2)
.Value = .Value
.Columns(j + 2).Sort KEY1:=.Item(j + 2), Order1:=1, Header:=2
.Columns(4) = "=" & .Cells(0, 4).Address(0, 0) & "+INT(RAND()*100+18)"
.Cells(1, 4) = "=INT(RAND()*100+18)+" & .Cells(1, 3)
.Value = .Value
For i = 1 To .Columns.Count
If A(i, j) = A(i + 1, j) Then
For x = 1 To 3: A(i + 1, j + x) = A(i, j + x): Next
A(i, j).Resize(2, 4).Interior.ColorIndex = 35
End If
Next
.Columns(j + 3).Sort KEY1:=.Item(j + 3), Order1:=1, Header:=2
.Sort KEY1:=.Item(5), Order1:=1, Header:=2
.Columns(5).ClearContents
End With
Next
.Columns(3) = "=" & A(1, 7).Address(0, 0) & "+" & A(1, 11).Address(0, 0) & "+" & A(1, 15).Address(0, 0) & "+" & A(1, 19).Address(0, 0) & "+" & A(1, 23).Address(0, 0)
.Sort KEY1:=.Item(3), Order1:=2, Header:=2
.Columns(4) = "=ROW()-2"
.Columns(5) = "=" & .Cells(0, 5).Address(0, 0) & "+INT(RAND()*30+1)"
A(1, 5) = "=INT(RAND()*30+1)"
.Columns(6) = "=" & .Cells(0, 6).Address(0, 0) & "+INT(RAND()*100+18)"
A(1, 6) = "=INT(RAND()*100+18)+" & A(1, 5)
.Value = .Value
For i = 1 To .Columns.Count
If A(i, 3) = A(i + 1, 3) Then
For x = 4 To 6: A(i + 1, x) = A(i, x): Next
A(i, 3).Resize(2, 4).Interior.ColorIndex = 35
End If
Next
End With
End Sub |
|
發表於 