- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 3# s13983037
n»¡²M·¡,¥unAÄæ¨C¤@Àx¦s®æªº¦r¦ê¶}ÀY¦bFÄ椤¦³¥X²{´NÅܦâ
ThisWorkbookª«¥ó¼Ò²Õªºµ{¦¡½X- Option Explicit
- Private Sub Workbook_Open()
- Run "SHEET1.Auto_Open", Range("A:A")
- 'SHEET1: Worksheet(1)->VBAªºª«¥ó¦WºÙ
- '§A¥iקï
- End Sub
½Æ»s¥N½X SHEET1ª«¥ó¼Ò²Õªºµ{¦¡½X- Option Explicit
- Dim Rng As Range, Ar
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim R
- If Rng Is Nothing Then Set_Rng
- If Intersect(Target, Rng) Is Nothing Then
- Auto_Open [a:a]
- ElseIf Not Intersect(Target, Rng) Is Nothing Then
- If Ar(Target.Row, 1) <> Target Then
- With Range("a:a").SpecialCells(xlCellTypeConstants)
- For Each R In .SpecialCells(xlCellTypeConstants)
- If UCase(R) Like UCase(Target & "*") Then
- R.Interior.ColorIndex = 6
- Else
- R.Interior.ColorIndex = xlNo
- End If
- Next
- End With
- End If
- Ar = Rng.Value
- End If
- End Sub
- Private Sub Set_Rng()
- Set Rng = Range("F1")
- Set Rng = Range(Rng, Rng.End(xlDown))
- Ar = Rng.Value
- End Sub
- Private Sub Auto_Open(Sheet_Rng As Range)
- Dim E As Range, R As Range
- Set_Rng
- With Sheet_Rng
- .Interior.ColorIndex = xlNo
- If Application.CountA(.Cells) > 0 Then
- For Each E In Rng
- For Each R In .SpecialCells(xlCellTypeConstants)
- If UCase(R) Like UCase(E) & "*" Then
- R.Interior.ColorIndex = 6
- End If
- Next
- Next
- End If
- End With
- End Sub
½Æ»s¥N½X |
|