- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 1# candy516
¸Õ¸Õ¬Ý- Option Explicit
- Sub Ex()
- Dim Rng As Range, °£®§¤é As Date, ªÑ²¼ As Range, R As Range, Ar(), i As Integer
- With Sheets("Sheet1")
- .Activate
- Set Rng = .Range("A2:A" & .Range("A2").End(xlDown).Row) '³]©wSheet1ªÑ²¼½d³ò
- If Application.Intersect(Rng, ActiveCell) Is Nothing Then '¨S¦³¿ï¾Ü¨ìªÑ²¼
- MsgBox "ªÑ²¼¥N¸¹: ¦³»~"
- Exit Sub
- End If
- Set Rng = ActiveCell
- 'Rng(1, 2) = Rng.Cells(1, 2)
- °£®§¤é = Mid(Rng(1, 2), 1, 4) & "/" & Mid(Rng(1, 2), 5, 2) & "/" & Mid(Rng(1, 2), 7, 2)
- End With
- ReDim Ar(1, 0)
- With Sheets(Mid(Rng(1, 2), 1, 4)) '°£®§¦~«×¤u§@ªí
- Set ªÑ²¼ = .Rows(1).Find(Rng, LOOKAT:=xlPart, LookIn:=xlValues) '§ä¨ìªÑ²¼¥N¸¹¦WºÙ ¤é³ø¹S²vÄæ¦ì
- For Each R In .Range("A3:A" & .Range("A3").End(xlDown).Row) '
- If R >= °£®§¤é And R <= °£®§¤é + 14 Then
- Ar(0, i) = R
- Ar(1, i) = R.Cells(1, ªÑ²¼.Column)
- i = i + 1
- ReDim Preserve Ar(1, i) '¼W¥[°}¦Cªººû¼Æ
- End If
- Next
- End With
- If i = 0 Then
- MsgBox "§ä¤£¨ì" & ªÑ²¼ & "¤é³ø¹S²v"
- Exit Sub
- End If
- With Sheets("Sheet2").Range("IV1").End(xlToLeft).Offset(, 1) 'Range("IV1")©¹¥ª¦³¸ê®Æªº²Ä¤@ÓÀx¦s®æ->Offset(, 1) ¦V¥k²¾°Ê¤@Äæ
- .Cells(1, 2) = ªÑ²¼
- .Cells(2, 1) = "¦~¤ë¤é"
- .Cells(2, 2) = "¤é³ø¹S²v"
- .Cells(3, 1).Resize(i, 2) = Application.WorksheetFunction.Transpose(Ar)
- End With
- End
- End Sub
½Æ»s¥N½X |
|