- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 278
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-12-25
|
¦^´_ 7# tonycho33
Sheet1¼Ò²Õ- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Set Rng = Range("B2:E2,B5:E5,B10:E10")
- Rng.Interior.ColorIndex = xlNone
- Rng.Font.ColorIndex = xlAutomatic
- If Not Intersect(Rng, Target) Is Nothing Then
- Set a = Sheet2.[A:B].Find(Target, lookat:=xlWhole)
- If Not a Is Nothing Then
- k = 3 - a.Column
- Ar = a.Offset(, k).Resize(, 5).Value
- With UserForm1
- .Show 0
- '¦]¬°TEXTBOX¨Ã¥¼¨Ì§Ç±Æ¦C©Ò¥H¥²¶·¤@¤@µ¹È
- .TextBox27 = Ar(1, 4)
- .TextBox28 = Ar(1, 5)
- .TextBox29 = Ar(1, 3)
- .TextBox30 = Ar(1, 2)
- .TextBox31 = Ar(1, 1)
- End With
- End If
- End If
- End Sub
½Æ»s¥N½X ¤@¯ë¼Ò²Õ- Sub Ex()
- Dim Ob As Shape, Ar(), Rng As Range
- Set Ob = Sheet1.Shapes(Application.Caller)
- Set Rng = Sheet1.Range("B2:E2,B5:E5,B10:E10")
- Rng.Interior.ColorIndex = xlNone
- Rng.Font.ColorIndex = xlAutomatic
- a = Asc(Ob.TextFrame.Characters.Text) + 2
- b = Sheet1.Cells(Ob.TopLeftCell.Row, "L").Value
- With Sheet2
- For Each c In .Range(Chr(a) & 1).EntireColumn.SpecialCells(xlCellTypeConstants)
- If c < b Then
- For i = 1 To 2
- If .Cells(c.Row, i) <> "" Then
- ReDim Preserve Ar(s)
- Ar(s) = .Cells(c.Row, i)
- s = s + 1
- End If
- Next
- End If
- Next
- End With
- If s > 0 Then
- For Each d In Ar
- With Rng.Find(d, lookat:=xlWhole)
- .Interior.ColorIndex = 3
- .Font.ColorIndex = 2
- End With
- Next
- End If
- End Sub
½Æ»s¥N½X |
|