owen06

回復 1# s7659109


    這樣有符合你的需求嗎？

1. Sub check_it()
   
2. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
   
3. Sheets("工作表1").Range("g21:l21").Clear
   
4. For i = 7 To 12
   
5.     For Each mrng In Sheets("工作表1").Range("B2:x18")
   
6.      If mrng.Value = Cells(20, i) Then
   
7.       mrng.Interior.ColorIndex = 6
   
8.       Cells(20, i).Offset(1, 0) = Cells(20, i).Offset(1, 0).Value + 1
   
9.      End If
   
10.     Next
    
11. Next
    
12. End Sub
    
13. 
    
14. Sub check_it2()
    
15. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
    
16. Sheets("工作表1").Range("G23:L23").Clear
    
17. RngA = Left([c22], Application.Find("-", [c22]) - 1)
    
18. RngB = Right([c22], Len([c22]) - (Application.Find("-", [c22])))
    
19. For x = 7 To 12
    
20.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
    
21.      If mrng.Value = Cells(22, x) Then
    
22.       mrng.Interior.ColorIndex = 6
    
23.       Cells(22, x).Offset(1, 0) = Cells(22, x).Offset(1, 0).Value + 1
    
24.      End If
    
25.     Next
    
26. Next
    
27. End Sub

複製代碼

owen06

回復 6# s7659109


    這樣子呢？

1. Sub check_it()
   
2. Range("B2:x18").Interior.ColorIndex = 0
   
3. Range("G21:L21").Clear
   
4. RngA = Left([c20], Application.Find("-", [c20]) - 1)
   
5. RngB = Right([c20], Len([c20]) - (Application.Find("-", [c20])))
   
6. For x = 7 To 12
   
7.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
   
8.      If mrng.Value = Cells(20, x) Then
   
9.       mrng.Interior.ColorIndex = 6
   
10.       Cells(20, x).Offset(1, 0) = Cells(20, x).Offset(1, 0).Value + 1
    
11.      End If
    
12.     Next
    
13.   If Cells(21, x) = "" Then Cells(21, x).Value = 0
    
14. Next
    
15. End Sub

複製代碼

owen06

回復 9# s7659109

像這樣？
另外你的b2:x18似乎因為儲存格有設定格式化條件的關係，所以有些資料跑出來的顏色會錯亂，把格式化條件清掉才會正常

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. With Target
   
3.    If .Row = 20 And .Column >= 7 And .Column <= 12 Then
   
4.     RngA = Left([C20], Application.Find("-", [C20]) - 1)
   
5.     RngB = Right([C20], Len([C20]) - (Application.Find("-", [C20])))
   
6.     Ans = .Value
   
7. On Error GoTo 99
   
8.    If Application.CountA([G20:L20]) = 0 Then GoTo 99
   
9.    If .Value = "" Then .Offset(1, 0) = ""
   
10.    
    
11.      For Each Mrng In Range("B" & RngA & ":x" & RngB)
    
12.        If Mrng.Value = Ans Then
    
13.         Mrng.Interior.ColorIndex = .Offset(-1, 0).Interior.ColorIndex
    
14.         .Offset(1, 0) = .Offset(1, 0).Value + 1
    
15.        End If
    
16.      Next
    
17.    End If
    
18. End With
    
19. Exit Sub
    
20. 
    
21. 99: Range("b2:x18").Interior.ColorIndex = 0: Range("G21:L21") = ""
    
22. End Sub

複製代碼