- 帖子
- 135
- 主題
- 19
- 精華
- 0
- 積分
- 165
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2003
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 香港
- 註冊時間
- 2010-12-9
- 最後登錄
- 2012-8-27
|
17#
發表於 2011-3-16 22:16
| 只看該作者
回復 1# oobird
做了VBA程式,不過等候時間較長,有時程式會自動中斷+有顯示錯誤,所以不要濫用VBA- Option Explicit
- Sub table()
- Dim classnumber As Object, mycell As Range
- Set classnumber = CreateObject("scripting.dictionary")
- With Range("S1")
- .Value = "考生號"
- .Offset(, 1).Value = "姓名"
- .Offset(, 2).Value = "化學"
- .Offset(, 3).Value = "外語"
- .Offset(, 4).Value = "生物"
- .Offset(, 5).Value = "地理"
- .Offset(, 6).Value = "物理"
- .Offset(, 7).Value = "政治"
- .Offset(, 8).Value = "語文"
- .Offset(, 9).Value = "數學"
- .Offset(, 10).Value = "歷史"
- End With
- Range("S2").Activate
- For Each mycell In Sheet1.Range([a2], [a65536].End(xlUp))
- If classnumber.exists(mycell.Value) Then
- Else
- classnumber.Add mycell.Value, mycell.Value
- ActiveCell.Value = mycell.Value
- ActiveCell.Offset(, 1).Value = mycell.Offset(, 1).Value
- ActiveCell.Offset(, 2).Value = mycell.Offset(, 3).Value
- ActiveCell.Offset(, 3).Value = mycell.Offset(1, 3).Value
- ActiveCell.Offset(, 4).Value = mycell.Offset(2, 3).Value
- ActiveCell.Offset(, 5).Value = mycell.Offset(3, 3).Value
- ActiveCell.Offset(, 6).Value = mycell.Offset(4, 3).Value
- ActiveCell.Offset(, 7).Value = mycell.Offset(5, 3).Value
- ActiveCell.Offset(, 8).Value = mycell.Offset(6, 3).Value
- ActiveCell.Offset(, 9).Value = mycell.Offset(7, 3).Value
- ActiveCell.Offset(, 10).Value = mycell.Offset(8, 3).Value
- ActiveCell.Offset(1).Activate
- End If
- Next
- For Each mycell In Range("U2:Ac643")
- If mycell.Value >= 85 Then
- mycell.Value = "A"
- ElseIf mycell.Value >= 65 And mycell.Value < 85 Then
- mycell.Value = "B"
- ElseIf mycell.Value < 65 Then
- mycell.Value = "C"
- End If
- Next
- Columns("S").NumberFormat = "0"
- Columns("S").AutoFit
- Set classnumber = Nothing
- End Sub
複製代碼 不過呢,可否降低下載附件的門檻,看那麼多無意義的回帖 |
|