- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2012-2-26 13:50
| 只看該作者
回復 5# donod
請複製到ThisWorkbook模組內- 'ThisWorkbook 的預設事件
- Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
- Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
- With Sh
- If Target.Address(0, 0) = "P7" Then '選擇了 P7
- Set B = .Range("T10:AE21") '制訂 B 組(分數- PT8) 範圍
- xX = 0 ' P欄
- ElseIf Target.Address(0, 0) = "Q7" Then '選擇了 Q7
- Set B = .Range("AH10:AS21") '制訂 C組(分數-PT8) 範圍
- xX = 1 ' P欄 右移一欄 :Q欄
- ElseIf Target.Address(0, 0) = "R7" Then '選擇了 R7
- Set B = .Range("AV10:BG21") '制訂 D組(分數-PT8) 範圍
- xX = 2 ' P欄 右移二欄 :R欄
- Else
- Exit Sub '離開程序
- End If
- Set A = .Range("H10:O21") '制訂 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, 5).Resize(, 8))), ",")
- Next
- For i = 1 To A.Rows.Count
- x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 8))), ",")
- x = Application.Match(x, Ar, 0) '工作表函數Match 在Ar尋找 相同字串
- A(i, 9 + xX) = "" '清除
- If Not IsError(x) Then '找到傳回數字
- B(x, 5).Resize(, 8).Interior.ColorIndex = 6
- A(i, 1).Resize(, 8).Interior.ColorIndex = 6
- A(i, 9 + xX) = B(x, 1) 'B,C,D,組的分數
- End If
- Next
- End With
- End Sub
|
|
發表於 2012-2-26 02:49
| 
