GBKEE

¦^´_ 1# bridetobe

1. Private Sub CommandButton1_Click()
   
2.     Dim a_date  ' As String
   
3.     a_date = InputBox("¿é¤J¤é´Á(¨Ò2014/7/1):")
   
4.     With Sheet2
   
5.         Set A = .Range("A2", .[a2].End(xlDown)).Find(what:=a_date, LookIn:=xlValues) '·j´M¤å¦r
   
6.     End With
   
7.     If Not A Is Nothing Then
   
8.         MsgBox ("¦³")
   
9.     Else
   
10.         MsgBox ("¨S¦³¸ê®Æ")
    
11.     End If
    
12. End Sub
    
13. Private Sub CommandButton2_Click()
    
14.     Dim a_date As Date
    
15.     a_date = InputBox("¿é¤J¤é´Á(¨Ò2014/7/1):")
    
16.     With Sheet2
    
17.         Set A = .Range("A2", .[a2].End(xlDown)).Find(what:=a_date, LookIn:=xlFormulas) '·j´M¤½¦¡
    
18.     End With
    
19.     If Not A Is Nothing Then
    
20.         MsgBox ("¦³")
    
21.     Else
    
22.         MsgBox ("¨S¦³¸ê®Æ")
    
23.     End If
    
24. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 4# bridetobe
¸Õ¸Õ¬Ý

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  ' As String
   
4.     Dim fndrange, fstaddress, i
   
5.     a_date = InputBox("¿é¤J¤é´Á(¨Ò2014/7/1):", , "2014/7/1")
   
6.     If a_date = "" Then Exit Sub  '¨ú®ø®É
   
7.     With Sheet2
   
8.     Set srcrange = .Range("A2", .[a2].End(xlDown))
   
9.         Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues) '·j´M¤å¦r
   
10.         'After     ¿ï¾Ü©Êªº Variant¡C  «ü©wÀx¦s®æ¡A´M§ä±N±q¸ÓÀx¦s®æ¤§«á¶}©l¡C¦¹Àx¦s®æ¹ïÀ³©ó±q¨Ï¥ÎªÌ¤¶­±´M§ä®Éªº¨Ï¥Î¤¤Àx¦s®æ¦ì¸m¡C
    
11.         'ª`·N After ¥²¶·¬O´M§ä½d³ò¤¤ªº³æ­ÓÀx¦s®æ¡C½Ð°O¦í´M§ä¬O±q¸ÓÀx¦s®æ¤§«á   ¶}©lªº¡F¥²¶·µ¥¨ì¸Ó¤èªk´`Àô¦^¨ì¦¹Àx¦s®æ®É¡A¤~·|·j´M¨ä¤º®e¡C
    
12.         '¦pªG¥¼«ü©w¦¹¤Þ¼Æ¡A·j´M±N±q½d³òªº¥ª¤W¨¤Àx¦s®æ¤§«á¶}©l
    
13.     End With
    
14.     If Not fndrange Is Nothing Then
    
15.         'fstaddress = fndress = fndrange.Address  '³o¸Ì¿ù»~ Åý¥LµL¤îºÉªº¶K¤U¥h
    
16.         fstaddress = fndrange.Address
    
17.         i = 3
    
18.         Do
    
19.         Cells(i, 1).Value = fndrange.Offset(, 1)
    
20.         Cells(i, 2).Value = fndrange.Offset(, 2)
    
21.         Cells(i, 3).Value = fndrange.Offset(, 3)
    
22.         Cells(i, 4).Value = fndrange.Offset(, 4)
    
23.         Cells(i, 5).Value = fndrange.Offset(, 5)
    
24.         Cells(i, 6).Value = fndrange.Offset(, 6)
    
25.         Cells(i, 7).Value = fndrange.Offset(, 7)
    
26.         Set fndrange = srcrange.FindNext(AFTER:=fndrange)
    
27.         i = i + 1
    
28.         Loop Until fndrange.Address = fstaddress
    
29.     Else
    
30.         MsgBox ("¨S¦³¸ê®Æ")
    
31.     End If
    
32. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# bridetobe
Find ·|®Ú¾Ú¤W£¸¦¸Findªº°Ñ¼Æ¨Ó·j´M

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  As String
   
4.     Dim fndrange As Range, fstaddress As String, i As Integer
   
5.     a_date = InputBox("¿é¤J¤é´Á(¨Ò2014/7/1):", , "2014/7/1")
   
6.     If a_date = "" Then Exit Sub  '¨ú®ø®É
   
7.     With Sheet2
   
8.     Set srcrange = .Range("A2", .[a2].End(xlDown))
   
9.         srcrange.Interior.ColorIndex = xlNone
   
10.         Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues, lookat:=xlWhole) '·j´M¤å¦r
    
11.         'After     ¿ï¾Ü©Êªº Variant¡C  «ü©wÀx¦s®æ¡A´M§ä±N±q¸ÓÀx¦s®æ¤§«á¶}©l¡C¦¹Àx¦s®æ¹ïÀ³©ó±q¨Ï¥ÎªÌ¤¶­±´M§ä®Éªº¨Ï¥Î¤¤Àx¦s®æ¦ì¸m¡C
    
12.         'ª`·N After ¥²¶·¬O´M§ä½d³ò¤¤ªº³æ­ÓÀx¦s®æ¡C½Ð°O¦í´M§ä¬O±q¸ÓÀx¦s®æ¤§«á   ¶}©lªº¡F¥²¶·µ¥¨ì¸Ó¤èªk´`Àô¦^¨ì¦¹Àx¦s®æ®É¡A¤~·|·j´M¨ä¤º®e¡C
    
13.         '¦pªG¥¼«ü©w¦¹¤Þ¼Æ¡A·j´M±N±q½d³òªº¥ª¤W¨¤Àx¦s®æ¤§«á¶}©l
    
14.                
    
15.         'LookAt  ¿ï¾Ü©Êªº Variant¡C¥i¬°¤U¦C XlLookAt ±`¼Æ¤§¤@¡GxlWhole ©Î xlPart¡C
    
16.         
    
17.     End With
    
18.     If Not fndrange Is Nothing Then
    
19.         'fstaddress = fndress = fndrange.Address  '³o¸Ì¿ù»~ Åý¥LµL¤îºÉªº¶K¤U¥h
    
20.         fstaddress = fndrange.Address
    
21.         i = 3
    
22.         Do
    
23.             fndrange.Interior.Color = vbRed
    
24.             Cells(i, 1).Resize(1, 7) = fndrange.Offset(, 1).Resize(1, 7).Value
    
25.             Set fndrange = srcrange.FindNext(AFTER:=fndrange)
    
26.             i = i + 1
    
27.         Loop Until fndrange.Address = fstaddress
    
28.     Else
    
29.         MsgBox ("¨S¦³¸ê®Æ")
    
30.     End If
    
31. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# bridetobe

1. Private Sub CommandButton1_Click()
   
2.     Dim srcrange As Range
   
3.     Dim a_date  As String
   
4.     Dim fndrange As Range, fstaddress As String, i As Integer
   
5.     a_date = InputBox("¿é¤J¤é´Á(¨Ò2014/7/1):", , "2014/7/1")
   
6.     Application.ScreenUpdating = False
   
7.    '******************
   
8.     Range("A3", Range("A3").End(xlDown)).Resize(, 7).ClearContents
   
9.     '*****************
   
10.     If a_date = "" Then Exit Sub

½Æ»s¥N½X

1. Private Sub CommandButton2_Click()
   
2.    Dim Rng As Range
   
3.    With Sheets("¾Þ§@")
   
4.        Set Rng = .Range("A3", .Range("A3").End(xlDown)).Resize(, 7)
   
5.        With Sheets("¦s³f¸ê®Æ").Range("B1").End(xlDown).Offset(1)
   
6.             .Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
   
7.             .Offset(, -1).Resize(Rng.Rows.Count) = Sheets("¾Þ§@").[b1]
   
8.         End With
   
9.     End With
   
10. End Sub

½Æ»s¥N½X

GBKEE

µ²ªGŪ¥XÅܦ¨µLªk¨Ï¥Î??
bridetobe µoªí©ó 2014/8/7 11:28

1. Private Sub CommandButton2_Click()
   
2.    Range("A59").Select
   
3.     Selection.CurrentRegion.Select
   
4.     Selection.Copy
   
5.     Sheets("Sheet4").Select
   
6.     With Sheet4
   
7.         ActiveSheet.Paste
   
8.         'Range("A1:G2").Select   '³o¸Ì¥X¿ù
   
9.         '³oCommandButton2¬O"¾Þ§@"¤u§@ªí[ª«¥ó¼Ò²Õ]ªºµ{§Ç
   
10.         'Range("A1:G2").Select¬O"¾Þ§@"¤u§@ªíªºRange.Select,¤£¬OActiveSheetªºRange.Select
    
11.         
    
12.         '¦pCommandButton2_Click()µ{¦¡½X½Æ»s¦b¤@¯ë¼Ò²Õ
    
13.         '³oRange¬OActiveSheetªºRange
    
14.     .Range("A1:G2").Select  '«e­±ªº. ªí¬°With Sheet4ªºª«¥ó,ÄÝ©Ê..
    
15.     Application.CutCopyMode = False
    
16.     Selection.ClearContents
    
17.     Range("A4").Select
    
18.     Selection.CurrentRegion.Select
    
19.     Selection.Copy        
    
20. End With
    
21. End Sub

½Æ»s¥N½X