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

[µo°Ý] ¦p¦ó±NWorksheet_ChangeªºÅܼƫŧi¡A§ï¦¨¦b¤@¯ë¼Ò²Õ¨Ï¥Î?

[µo°Ý] ¦p¦ó±NWorksheet_ChangeªºÅܼƫŧi¡A§ï¦¨¦b¤@¯ë¼Ò²Õ¨Ï¥Î?

¥»©«³Ì«á¥Ñ jackson7015 ©ó 2014-4-29 09:12 ½s¿è

½Ð°Ý¦U¦ì«e½ú
¦p¦ó±N¤U­±Worksheet¤¤ªºÅܼƫŧi¡A§ï¦¨¦b¼Ò²Õªº¤@¯ë¥¨¶°´N¦n¤F?

¦]¬°°µ¤F¨ä¥L¥¨¶°­n¨Ï¥Î
¦ý¬O¥u­n¦³§ó°Ê¨ìWorksheetªº³æ®æÀx¦s®æ¡A´N·|±Ò°Ê¦¹«Å§i

·Q½Ð±Ð«e½ú­Ì¡A¦p¦ó±N¥H¤UÅܼƫŧi¡A§ï¦¨¤@¯ë¼Ò²Õªº¥¨¶°¨Ï¥Î¥B¥u§@¥Î¦b[a5]Àx¦s®æ´N¦n¤F
·PÁ¤£§[«ü±Ð~
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim A As Range, Rng As Range
  3. If Target.Column = 1 Then
  4. With Sheets("ºî¦X¸ê®Æ®w")
  5. For i = 1 To .UsedRange.Rows.Count
  6.    Set A = .UsedRange.Rows(i).Find(Target)
  7.    If Not A Is Nothing Then
  8.      If Rng Is Nothing Then
  9.      Set Rng = .UsedRange.Rows(i)
  10.      Else
  11.      Set Rng = Union(Rng, .UsedRange.Rows(i))
  12.      End If
  13.     End If
  14. Next
  15. End With
  16. End If
  17. Application.EnableEvents = False
  18.     If Not Rng Is Nothing Then
  19.     Rng.Copy: Target.Offset(, 1).PasteSpecial 3
  20.     Else
  21.     Target.Offset(, 1).Resize(, 50) = ""
  22.     End If
  23. Application.EnableEvents = True
  24.     MsgBox "¬d¸ßµ²§ô"
  25. End Sub
½Æ»s¥N½X

¦^´_ 16# GBKEE
·PÁÂGBKEEª©¤jªº¦^ÂÐ

­ì¨Ó°±¯dªº¬í¼Æ¬Oµ{¦¡­ì¥»ªº³]©w°Ú¡AÁÙ¥H¬°¬OApplication.Wait Time ªºÃö«Y¡A·Q»¡³o½s½X¦n¹³¤£¯à¼g¤p©ó1¬í

³o½g°Q½×Àò¯q¨}¦h
¨Ï¥Î¨ìªº¬ÛÃö½s½XÁÙ¦³«Ü¦h¤£©ú¥Õªº¡A¦AºCºC¦a®ø¤Æ
¥Ñ°J·PÁÂGBKEE¤j¤jªº¥I¥X¡AÁÂÁÂ~

TOP

¦^´_ 15# jackson7015
°Ñ¦Ò³o¸Ì
  1. Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  2. Sub ¬d¸ß¸ê®Æ()
  3.     UserForm1.Show
  4. End Sub
½Æ»s¥N½X
  1. Private Sub UserForm_Activate()
  2.     Dim F As Range, AD As String, Rng As Range, i
  3.     xRng.CurrentRegion.Offset(1, 1) = ""
  4.     Application.Wait Time + #12:00:01 AM#
  5.     With Sheets("ºî¦X¸ê®Æ®w").UsedRange
  6.         Set F = .Find(xRng, LOOKAT:=xlPart)
  7.         If Not F Is Nothing Then AD = F.Address
  8.         Do While Not F Is Nothing
  9.             i = i + 1
  10.             Label1.Caption = xRng & vbTab & "¬d¨ì " & i & " µ§"
  11.             DoEvents
  12.             Sleep 100   '§ï¥Î¼È°±0.1¬í
  13.            ' Application.Wait Time + #12:00:01 AM#
  14.             If Rng Is Nothing Then
  15.                 Set Rng = .Rows(F.Row)
  16.             Else
  17.                 Set Rng = Union(Rng, .Rows(F.Row))
  18.             End If
  19.             Set F = .FindNext(F)
  20.             If F.Address = AD Then Exit Do
  21.         Loop
  22.     End With
  23.     If Not Rng Is Nothing Then
  24.         Rng.Copy xRng.Offset(, 1)
  25.     Else
  26.         Label1.Caption = xRng & vbTab & "¬dµL¸ê®Æ"
  27.         DoEvents
  28.         Sleep 100
  29.         'Application.Wait Time + #12:00:01 AM#
  30.     End If
  31.     Unload Me
  32. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 14# GBKEE
·PÁÂGBKEEª©¤jªº¦^À³

µ{¦¡°õ¦æ°_¨Ó§ó¦³¨t²Î¡A¤]§ó¬üÆ[¤F
·Q½Ð°Ýª©¤j
¦]¬°¦³®É­Ô·j´M¥ó¼Æ·|¦³¹F¨ì¼Æ¤Q¥ó¡A¬Æ¦Ü¦Ê¥ó
¦Ó¤j²¤¬Ý¤F±zªº½s¼g¡A¨C¦¸·|©µ¿ð1¬í°µ°j°é
³o¼Ë·|¦³«Üªø®É¶¡¦bµ¥«Ý°j°éªº¹Bºâ

¬O§_¦³ª½±µ¥HMsgBoxÅã¥Ü"·j´M¤¤"
µM«á·j´Mµ²§ô«áMsgBox®Ø¬[´N·|¦Û°Ê®ø¥¢ªº½s¼g¤è¦¡ ?(¤£¬O©µ¿ð¬í¼Æ)

«D±`·PÁÂGBKEEª©¤jÁÙ¯S§O¼g¤FTextBoxªºµ{¦¡

TOP

³o°ÝÃD©M¥DÃD¨S¦³¤@­P¡A§Ú·QÁÙ¬O¥t¶}­Ó¥DÃD¤ñ¸û¦X¾A?
¦^´_ 13# jackson7015
µL¶·¥t¶}­Ó¥DÃD,¥iÄ~Äò¤U¥h

¸Õ¸Õ¬Ý Ex.rar (520.17 KB)
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 12# GBKEE
·PÁÂGBKEEª©¤j

¦¹µ{¦¡½X¬Oµ¹¥¦³]©w¬í¼Æ,´N·|¦A«ü©w®É¶¡¤º Aoto Close

¤£¹L§Ú·Q¸ß°Ýªº¬O
¶}©l°õ¦æµ{¦¡½Xªº®É­Ô·|¥X²{MsgBox ¡AµM«áµ{¦¡½X°õ¦æµ²§ô«áMsgBox ¤]¸òµÛ®ø¥¢

¥H³o½gªº10¼Óµ{¦¡½X¬°¨Ò¡G
°õ¦æµ{¦¡½X>¥X²{MsgBox "¬d¸ß¤¤">¬d¸ßµ²§ô«á>MsgBox ®ø¥¢
³o°ÝÃD©M¥DÃD¨S¦³¤@­P¡A§Ú·QÁÙ¬O¥t¶}­Ó¥DÃD¤ñ¸û¦X¾A?

¦b¦¹¥Ñ°Jªº·PÁÂGBKEEª©¤jµL¨pªº±Ð¾É

TOP

¦^´_ 11# jackson7015
  1. Sub MsgBox_Wait()
  2. Dim WshShell, BtnCode
  3. Set WshShell = CreateObject("WScript.Shell")
  4. BtnCode = WshShell.popup("µ¥«Ý2¬í¤£«ö§Ú´N¦Û°ÊÃö³¬?", 2, "´ú¸Õ:", 4 + 16)
  5. Select Case BtnCode
  6.    Case 6
  7.    BtnCode = "§A«ö¤F""¬O""." 'MsgBox "§A«ö¤F""¬O""."
  8.    Case 7
  9.    BtnCode = "§A«ö¤F""§_""." 'MsgBox "§A«ö¤F""§_""."
  10.    Case -1
  11.    BtnCode = "¨S¦³«ö¥ô¦óÁä"
  12. End Select
  13. BtnCode = WshShell.popup(BtnCode, 2, "´ú¸Õ§¹²¦", 1)
  14. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ jackson7015 ©ó 2014-5-8 09:09 ½s¿è

¦^´_ 10# GBKEE
·PÁÂGBKEEª©¤jªºÀ°¦£
¥i¥H¥¿±`¹B§@¤F

¦Û¤v©Ò»Ý­nªº³¡¤À¬O¤U­±ªº¨º¨Çµ{¦¡½X¡A§R°£¤F¨Ç¤£»Ý­nªº³¡¤À
vbªºµ{¦¡½X³£¤£·|½s¼g¡A³£¥u·|¤@¨Ç²³æªº¤@¯ë°Ï½s¼g
·PÁª©¤jªºµL¤ß¥I¥X

·Q¦A½Ð°Ýª©¤jMsgBoxªº°ÝÃD
¦pªG§Ú·Q¦b¤U¦Cªºµ{¦¡½X¤¤´¡¤J¤@«h"¬d¸ß¤¤"ªºMsgBox¡A¦ý¬O·|¦b·j´Mµ²§ô«á¡AMsgBoxµøµ¡·|¦Û°Ê®ø°£
¨ººØMsgBox»yªk¸Ó«ç»ò½s¼g ?

¬d¸ß¤F¯¸¤W¸ê®Æ¡A§ä¤£¤Ó¨ìMsgBox¦Û°Êµ²§ôªº¬ÛÃö¸ê®Æ
  1. Sub ¬d¸ß¸ê®Æ()
  2.     Dim F As Range, AD As String, Rng As Range, xRng As Range
  3.     Set xRng = Sheets("¬d¸ß¥Îªí³æ").[A5]
  4.     With Sheets("ºî¦X¸ê®Æ®w").UsedRange
  5.         Set F = .Find(xRng, LOOKAT:=xlPart)
  6.         If Not F Is Nothing Then AD = F.Address
  7.         Do While Not F Is Nothing
  8.             If Rng Is Nothing Then
  9.                 Set Rng = .Rows(F.Row)
  10.             Else
  11.                 Set Rng = Union(Rng, .Rows(F.Row))
  12.             End If
  13.             Set F = .FindNext(F)
  14.             If F.Address = AD Then Exit Do
  15.         Loop
  16.     End With
  17.     If Not Rng Is Nothing Then
  18.         Rng.Copy xRng.Offset(, 1)
  19.         MsgBox "¬d¸ßµ²§ô"
  20.     Else
  21.         xRng.Offset(, 1).Resize(, 50) = ""
  22.     End If
  23. End Sub
½Æ»s¥N½X

TOP

¦^´_ 9# jackson7015
¸Õ¸Õ¬Ý
  1. '³£¬OModule3¤Wªºµ{¦¡½X
  2. Sub ¬d¸ß¸ê®Æ()
  3.    ' Worksheet_Change [A5]   '¥i¥H³o¼Ë°µ
  4.     Ex
  5. End Sub
  6. 'Sheets("¬d¸ß¥Îªí³æ")ªºWorksheet_Change¨Æ¥ó,§A¬O·Q·h²¾¨ìModule3¼Ò²Õ¤W
  7. Private Sub Worksheet_Change(ByVal Target As Range)
  8. Dim A As Range, Rng As Range
  9. If Target.Column = 1 Then
  10. With Sheets("ºî¦X¸ê®Æ®w")
  11. For i = 1 To .UsedRange.Rows.Count
  12.    Set A = .UsedRange.Rows(i).Find(Target)
  13.    If Not A Is Nothing Then
  14.      If Rng Is Nothing Then
  15.      Set Rng = .UsedRange.Rows(i)
  16.      Else
  17.      Set Rng = Union(Rng, .UsedRange.Rows(i))
  18.      End If
  19.     End If
  20. Next
  21. End With
  22. End If
  23. Application.EnableEvents = False
  24.     If Not Rng Is Nothing Then
  25.     Rng.Copy: Target.Offset(, 1).PasteSpecial 3
  26.     Else
  27.     Target.Offset(, 1).Resize(, 50) = ""
  28.     End If
  29. Application.EnableEvents = True
  30.     MsgBox "¬d¸ßµ²§ô"
  31. End Sub
  32. Private Sub Ex()
  33.     Dim F As Range, AD As String, Rng As Range, xRng As Range
  34.     Set xRng = Sheets("¬d¸ß¥Îªí³æ").[A5]
  35.     With Sheets("ºî¦X¸ê®Æ®w").UsedRange
  36.         Set F = .Find(xRng, LOOKAT:=xlPart)
  37.         If Not F Is Nothing Then AD = F.Address
  38.         Do While Not F Is Nothing
  39.             If Rng Is Nothing Then
  40.                 Set Rng = .Rows(F.Row)
  41.             Else
  42.                 Set Rng = Union(Rng, .Rows(F.Row))
  43.             End If
  44.             Set F = .FindNext(F)
  45.             If F.Address = AD Then Exit Do
  46.         Loop
  47.     End With
  48.     If Not Rng Is Nothing Then
  49.         Rng.Copy xRng.Offset(, 1)
  50.         MsgBox "¬d¸ßµ²§ô"
  51.     Else
  52.         xRng.Offset(, 1).Resize(, 50) = ""
  53.     End If
  54. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 6# GBKEE

Àɮפwªþ¤W¡A¦A½ÐGBKEE¤j¤j¬Ý¬Ý¬O§_¥i¦æ

¤µ¤Ñ¬ã¨s¤F¥b¤ÑÁÙ¬O¤£·|§ï...

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD