- 帖子
- 967
- 主題
- 0
- 精華
- 0
- 積分
- 1001
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-11-29
- 最後登錄
- 2022-5-17
 
|
16#
發表於 2012-2-28 15:17
| 只看該作者
回復 15# donod - Option Explicit
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
- If Target.Address(0, 0) = "Q8" Then '選擇了 Q8
- Set B = Range("V9:AJ20") '制訂 B 組(分數- PT8) 範圍
- xX = 0 ' Q欄
- ElseIf Target.Address(0, 0) = "R8" Then '選擇了 R8
- Set B = Range("AM9:BA20") '制訂 C組(分數-PT8) 範圍
- xX = 1 ' P欄 右移一欄 :R欄
- ElseIf Target.Address(0, 0) = "S8" Then '選擇了 S8
- Set B = Range("BD9:BR20") '制訂 D組(分數-PT8) 範圍
- xX = 2 ' P欄 右移二欄 :S欄
- ElseIf Target.Address(0, 0) = "T8" Then '選擇了 T8
- Set B = Range("BU9:CI20") '制訂 E組(分數-PT8) 範圍
- xX = 3 ' P欄 右移三欄 :T欄
- Else
- Exit Sub '離開程序
- End If
- Set A = Range("G9:P20") '制訂 A 組(PT1-PT8) 範圍
- A.Interior.ColorIndex = xlNone '清除A 組(PT1-PT8) 範圍圖樣
- B.Interior.ColorIndex = xlNone '清除B ,C , D. 組 範圍圖樣
- ReDim Ar(1 To A.Rows.Count) '重新宣告 陣列的維數
- For i = 1 To B.Rows.Count '取得B,C,D,組的 (PT1-PT8) 的內容 置入陣列 Ar
- Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 6).Resize(, 10))), ",")
- Next
- For i = 1 To A.Rows.Count
- x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
- x = Application.Match(x, Ar, 0) '工作表函數Match 在Ar尋找 相同字串
- A(i, 11 + xX) = "" '清除
- If Not IsError(x) Then '找到傳回數字
- B(x, 6).Resize(, 10).Interior.ColorIndex = 6
- A(i, 1).Resize(, 10).Interior.ColorIndex = 6
- A(i, 11 + xX) = B(x, 1) 'B,C,D,E組的分數
- End If
- Next
- End Sub
如每張工作表之格式不同,那就要每張工作表分別放工作表模組 |
|
發表於 2012-2-28 10:46
| 
