donod

回復 9# GBKEE


    請教大大，是什麼位置出錯?
TEST A4.rar (37.95 KB)

下載次數: 5

2012-2-28 00:40

GBKEE

回復 11# donod
Module1 中 的Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 是不會 有動作的
那是ThisWorkbook 的預設事件 那程序必須是在 ThisWorkbook中
你每一工作表的 B,C,D組的位置都不一樣 當然會不準確
需用每一工作表的預設事件 程序  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
依每一工作表的 B,C,D組的位置 去設定

donod

回復 12# GBKEE


    改了，煩請大大看看是哪裡錯，謝謝!
TEST A6.rar (38.92 KB)

下載次數: 4

2012-2-28 13:43

GBKEE

回復 13# donod
用ThisWorkbook模組內   Private Sub Worksheet_SelectionChange(ByVal Target As Range)程序
是因為如 每一工作表有B,C,D 分組的 位置都一樣可用   Private Sub Workbook_SheetSelectionChange   不必每一工作表模組內去寫程序

現在因每一工作表B,C,D 分組的 位置都不一樣  所以啊
每一有B,C,D 分組的工作表模組內 都要一有個它適用的   Private Sub Worksheet_SelectionChange(ByVal Target As Range)程序

donod

回復 14# GBKEE


    謝謝大大回覆!
但第1張工作頁錯在什麼，請大大指教!
TEST A6.rar (38.92 KB)

下載次數: 3

2012-2-28 15:09

register313

回復 15# donod

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
   
4. If Target.Address(0, 0) = "Q8" Then       '選擇了 Q8
   
5.     Set B = Range("V9:AJ20")              '制訂 B 組(分數- PT8) 範圍
   
6.     xX = 0                                ' Q欄
   
7. ElseIf Target.Address(0, 0) = "R8" Then   '選擇了 R8
   
8.     Set B = Range("AM9:BA20")             '制訂 C組(分數-PT8) 範圍
   
9.     xX = 1                                ' P欄 右移一欄 :R欄
   
10. ElseIf Target.Address(0, 0) = "S8" Then   '選擇了 S8
    
11.     Set B = Range("BD9:BR20")             '制訂 D組(分數-PT8) 範圍
    
12.     xX = 2                                ' P欄 右移二欄 :S欄
    
13. ElseIf Target.Address(0, 0) = "T8" Then   '選擇了 T8
    
14.     Set B = Range("BU9:CI20")             '制訂 E組(分數-PT8) 範圍
    
15.     xX = 3                                ' P欄 右移三欄 :T欄
    
16. Else
    
17.     Exit Sub                              '離開程序
    
18. End If
    
19. Set A = Range("G9:P20")                   '制訂 A 組(PT1-PT8) 範圍
    
20. A.Interior.ColorIndex = xlNone            '清除A 組(PT1-PT8) 範圍圖樣
    
21. B.Interior.ColorIndex = xlNone            '清除B ,C , D. 組 範圍圖樣
    
22. ReDim Ar(1 To A.Rows.Count)               '重新宣告 陣列的維數
    
23. For i = 1 To B.Rows.Count                 '取得B,C,D,組的 (PT1-PT8) 的內容  置入陣列 Ar
    
24.     Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 6).Resize(, 10))), ",")
    
25. Next
    
26. For i = 1 To A.Rows.Count
    
27.     x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
    
28.     x = Application.Match(x, Ar, 0)       '工作表函數Match 在Ar尋找 相同字串
    
29.     A(i, 11 + xX) = ""                    '清除
    
30.     If Not IsError(x) Then                '找到傳回數字
    
31.         B(x, 6).Resize(, 10).Interior.ColorIndex = 6
    
32.         A(i, 1).Resize(, 10).Interior.ColorIndex = 6
    
33.         A(i, 11 + xX) = B(x, 1)           'B,C,D,E組的分數
    
34.     End If
    
35. Next
    
36. End Sub

複製代碼

另外建議每張工作表應有相同之格式(可以作到的),這樣就可以只用一個活頁簿模組
如每張工作表之格式不同,那就要每張工作表分別放工作表模組

GBKEE

回復 15# donod
With Target
        If Target.Address(0, 0) = "Q8" Then         '選擇了 Q8
            Set B = .Range("V9:AJ20")              '制訂 B 組(分數- PT8) 範圍
            B.Select    '   ***  加上這行看看  B的範圍在哪裡

16# 修改為 Set B = Range("V9:AJ20")   少了 一個點 Set B = .Range("V9:AJ20")    就正確了
有這 一點 代表是 以 With Target 為基點 所擴展的範圍

donod

回復 16# register313


   可以了! 謝謝大大!

donod

回復 17# GBKEE


    謝謝大大!這樣修改正確嗎?
TEST A7.rar (37.85 KB)

下載次數: 5

2012-2-28 17:17

GBKEE

回復 19# donod
如此只有SHEETS("1" )有程式碼可以, 其他工作表沒有是沒有動作的