luhpro

¦^´_ 1# emmalee
¥H¤Uµ{¦¡©ñ¦b Sheet2 ¤º

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim iRow%
   
3.   
   
4.   With Target
   
5.     If .Column = 2 And .Row = 1 Then
   
6.       Application.EnableEvents = False
   
7.       With .Parent
   
8.         iRow = .Cells(Rows.Count, 1).End(xlUp).Row
   
9.         If iRow < 3 Then iRow = 3
   
10.         .Range(.[A3], .Cells(iRow, 2)).Clear
    
11.       End With
    
12.       Call GetDate(Target)
    
13.       Application.EnableEvents = True
    
14.       Target.Select
    
15.       
    
16.     End If
    
17.   End With
    
18. End Sub

½Æ»s¥N½X

¥H¤Uµ{¦¡©ñ¦b Module ¤º

1. Sub GetDate(ByVal rTar As Range)
   
2.   Dim iRow%
   
3.   Dim dDate As Date
   
4.   Dim vSheet1, rFind As Range
   
5.   
   
6.   On Error Resume Next
   
7.   Set vSheet1 = Sheets("Sheet1")
   
8.   
   
9.   With vSheet1
   
10.     iRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
11.     Set rFind = Nothing
    
12.     dDate = rTar.Value
    
13.     Do Until rFind.Row > 1
    
14.       Set rFind = Range(.[A2], .Cells(iRow, 1)).Find(dDate, LookIn:=xlValues)
    
15.       dDate = dDate + 1
    
16.     Loop
    
17.       .Range(rFind, .Cells(iRow, 2)).Copy
    
18.       rTar.Parent.[A3].PasteSpecial Paste:=xlPasteAll
    
19.   End With
    
20. End Sub

½Æ»s¥N½X