ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð¤j®v­ÌÀ°¦£¦Û°ÊÅÜ´«ÃC¦â,ÁÂÁÂ

http://blog.xuite.net/hcm19522/twblog/205029860

TOP

¸g¹L­ã¤j¦A¤T«ü¾É, ²×©ó§¹¦¨¤F, ÁÂÁ­ã¤j.
test.gif
2015-11-22 22:05

TOP

TOP

¦^´_ 23# yen956
Sorry, ¦^À³¿ù¥DÃD, ¹ï s7659109¤j¤j¤Î¬ÛÃöŪªÌ§¡«D±`©êºp,
¤w­«·s¶K¨ì¤U¦C¥DÃD¤¤, ©êºp!!
http://forum.twbts.com/viewthrea ... a=pageD1&page=3

TOP

¸g­ã¤j¦A¤T«ü¥¿, ²×©ó§¹¦¨
test.gif
2015-11-23 16:03

Åã¥Ü¿é¤J­È¶ñº¡ÃC¦â2.rar (28.32 KB)

TOP

³sÄò¨â¦¸³£¶K¿ù¦a¤è, ¹ê¦b¤£¥i­ì½Ì!!
·Q¶Kªº¬O³o­Ó!!
¸Õ¸Õ¬Ý!!
sheet1(³]³Æ¦Cªí)ªºVBA Code¦p¤U:
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim rngA As Range, rngB As Range, foundCel As Range
  4.     Dim lastRow As Long
  5.     If Target.Count > 1 Then Exit Sub         '¦pªG¤@¦¸Change¤Ó¦h®æ´NÂ÷¶}
  6.     lastRow = Sheets("¤½¥q²M³æ").Cells(Rows.Count, 2).End(xlUp).Row
  7.     Set rngA = Sheets("¤½¥q²M³æ").Range("B2:B" & lastRow & "")   '³]©w "¤½¥q²M³æ" ªº½d³òµ¹ rngA
  8.     lastRow = Cells(Rows.Count, 2).End(xlUp).Row
  9.     Set rngB = Range("B2:B" & lastRow & "")          '³]©w "³]³Æ¦Cªí" ªº½d³òµ¹ rngB
  10.     If Not Intersect(Target, rngB) Is Nothing Then
  11.         Set foundCel = rngA.Find(Target, lookat:=xlWhole)       'rngA ¤¤´M§ä Target
  12.         If Not foundCel Is Nothing Then        '¦³§ä¨ì
  13.             Target.Offset(0, -1).Resize(1, 11).Interior.ColorIndex = _
  14.                         foundCel.Offset(0, 1).Interior.ColorIndex
  15. '        Else
  16.             '«Øij "³]³Æ¦Cªí" ªº "¨Ï¥Î¤½¥q" ¥Î ÅçÃÒ²M³æ ¿é¤J
  17.             '«h¦¹³B´N¤£¥²Àˬd¿é¤J¬O§_¦³¿ù»~, ´«¨¥¤§, ´N¨S¦³ Else ³o¤@¬q
  18.             '¤S ÅçÃÒ²M³æ ¦rÅé«Ü¤p¤S¤£¯à§ï, ¤£¾A¦X®zµøªÌ,
  19.             '«Øij "³]³Æ¦Cªí" ¾ã­¶¥þ³¡§ï¥Î¤p¦rÅé, ¦A©ñ¤jÀ˵ø¤ñ¨Ò
  20.         End If
  21.     End If
  22. End Sub
½Æ»s¥N½X
sheet2(¤½¥q²M³æ)ªºVBA Code¦p¤U:
  1. Option Explicit
  2. Public colorNum As Integer

  3. '¥ý°õ¦æ¦¹VBA¤@¦¸, ¥H«Ø¥ß¥N½Xªí
  4. Sub ÃC¦â¥N½Xªí()
  5.     Dim i As Integer
  6.     For i = 1 To 28
  7.         Cells(i, 15).Interior.ColorIndex = i
  8.         Cells(i, 16).Interior.ColorIndex = i + 28
  9.     Next
  10. End Sub

  11. '§@¥Î¡G¥Î¥H½s¿è"¤½¥q²M³æ"CÄ檺Àx¦s®æÃC¦â
  12. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  13.     Dim rng As Range
  14.     If Target.Count > 1 Then Exit Sub
  15.     Set rng = Application.Union([C:C], [O1:P28])
  16.     If Intersect(Target, rng) Is Nothing Then Exit Sub
  17.     If Target.Column = 3 Then
  18.         Target.Interior.ColorIndex = colorNum
  19.     Else
  20.         colorNum = Target.Interior.ColorIndex
  21.     End If
  22. End Sub
½Æ»s¥N½X
test2.gif
2015-11-23 19:01

´ú¸ÕÀÉ®×.rar (381.48 KB)

TOP

        ÀR«ä¦Û¦b : ¡i»X½ªªº¦Û¥Ñ¡j¤H±`¦b¤°»ò³£¥i¥H¦Û¥Ñ¦Û¦bªº®É­Ô¡A«o³Q³oºØÀH¤ß©Ò±ýªº¦Û¥Ñ»X½ª¡AµêÂY®É¥ú¦Ó²@µLıª¾¡C
ªð¦^¦Cªí ¤W¤@¥DÃD