GBKEE

¦^´_ 1# s13983037
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range
   
4.     With Worksheets(1).Columns("A:A")
   
5.         .Parent.Activate
   
6.         Set Rng = .Range("F1")
   
7.         Set Rng = .Range(Rng, Rng.End(xlDown))
   
8.         .FormatConditions.Delete
   
9.         With .SpecialCells(xlCellTypeConstants)
   
10.             .Cells(1).Select
    
11.             .FormatConditions.Add Type:=xlExpression, Formula1:="=MATCH(" & .Cells(1).Address(0, 0) & "," & Rng.Address(1, 1) & ",0)>0"
    
12.             With .FormatConditions(1).Interior
    
13.                 .ColorIndex = 6
    
14.                 .PatternColorIndex = xlAutomatic
    
15.             End With
    
16.         End With
    
17.     End With
    
18. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# s13983037
­n»¡²M·¡,¥u­nAÄæ¨C¤@Àx¦s®æªº¦r¦ê¶}ÀY¦bFÄ椤¦³¥X²{´NÅܦâ
ThisWorkbookª«¥ó¼Ò²Õªºµ{¦¡½X

1. Option Explicit
   
2. Private Sub Workbook_Open()
   
3.     Run "SHEET1.Auto_Open", Range("A:A")
   
4.     'SHEET1: Worksheet(1)->VBAªºª«¥ó¦WºÙ
   
5.     '§A¥i­×§ï
   
6. End Sub

½Æ»s¥N½X

SHEET1ª«¥ó¼Ò²Õªºµ{¦¡½X

1. Option Explicit
   
2. Dim Rng As Range, Ar
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.     Dim R
   
5.     If Rng Is Nothing Then Set_Rng
   
6.     If Intersect(Target, Rng) Is Nothing Then
   
7.         Auto_Open [a:a]
   
8.     ElseIf Not Intersect(Target, Rng) Is Nothing Then
   
9.         If Ar(Target.Row, 1) <> Target Then
   
10.             With Range("a:a").SpecialCells(xlCellTypeConstants)
    
11.                 For Each R In .SpecialCells(xlCellTypeConstants)
    
12.                     If UCase(R) Like UCase(Target & "*") Then
    
13.                         R.Interior.ColorIndex = 6
    
14.                     Else
    
15.                         R.Interior.ColorIndex = xlNo
    
16.                     End If
    
17.                    Next
    
18.             End With
    
19.         End If
    
20.         Ar = Rng.Value
    
21.     End If
    
22. End Sub
    
23. Private Sub Set_Rng()
    
24.     Set Rng = Range("F1")
    
25.     Set Rng = Range(Rng, Rng.End(xlDown))
    
26.     Ar = Rng.Value
    
27. End Sub
    
28. 
    
29. Private Sub Auto_Open(Sheet_Rng As Range)
    
30.     Dim E As Range, R As Range
    
31.     Set_Rng
    
32.     With Sheet_Rng
    
33.         .Interior.ColorIndex = xlNo
    
34.         If Application.CountA(.Cells) > 0 Then
    
35.             For Each E In Rng
    
36.                 For Each R In .SpecialCells(xlCellTypeConstants)
    
37.                     If UCase(R) Like UCase(E) & "*" Then
    
38.                         R.Interior.ColorIndex = 6
    
39.                     End If
    
40.                 Next
    
41.             Next
    
42.         End If
    
43.     End With
    
44. End Sub

½Æ»s¥N½X