GBKEE

¦^´_ 1# jackson7015

SHEET1ªºWorksheet_Change ¨Æ¥ó

1. Run "SHEET1.Worksheet_Change", Sheet1.[A5]

½Æ»s¥N½X

GBKEE

¦^´_ 3# jackson7015
§A¤£¬O­n¦b¨ä¥Lªº¥¨¶°¤¤,°õ¦æ³oµ{¦¡½X,¨Ó°õ¦æSheet1(¬d¸ß¥Îªí³æ)ªºWorksheet_Change¨Æ¥óµ{¦¡¶Ü?

GBKEE

¦^´_ 5# jackson7015
¬O³o¼Ë¶Ü?

1. Sub ²M°£¬d¸ßªí®æ()
   
2. ' ²M°£¬d¸ßªí®æ ¥¨¶°
   
3.     With Sheets("¬d¸ß¥Îªí³æ")
   
4.         .Range("$B5:$BR301").ClearContents
   
5.         .Range("A5").Select
   
6.         Run "Module1.Worksheet_Change", .[A5]
   
7.         '§A¤w±N Worksheet_Changeªº½s¼g¡A§ï¦¨¦bModule1¼Ò²Õ
   
8.     End With
   
9. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 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

GBKEE

¦^´_ 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

GBKEE

³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)

¤U¸ü¦¸¼Æ: 7

2014-5-9 15:01

GBKEE

¦^´_ 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