標題:
[發問]
救救我吧！日期複製（詳情請參閱內文）
[打印本頁]
作者:
emmalee
時間:
2011-6-8 22:50
標題:
救救我吧！日期複製（詳情請參閱內文）
步驟一：當使用者在b1輸入開始日期(不定期)
步驟二：到sheet1中搜尋到b1日期後選取開始日到最終日期today()=>黃色底，並複製
步驟三：把sheet1黃色底複製到sheet2的a3
請問巨集要怎麼做???????:'(
作者:
Hsieh
時間:
2011-6-8 23:39
本帖最後由 Hsieh 於 2011-6-9 23:56 編輯
回復
1#
emmalee
SHEET1工作表模組
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Then Exit Sub
With Sheet2
Set a = .Columns("A").Find(Target, LookIn:=xlValues)
Set b = .Columns("A").Find(Date, LookIn:=xlValues)
If Not a Is Nothing And Not b Is Nothing Then
Range([A3], Cells(Rows.Count, 2)) = ""
.Range(a, b.Offset(, 1)).Copy [A3]
End If
End With
End Sub
複製代碼
作者:
luhpro
時間:
2011-6-9 00:20
本帖最後由 luhpro 於 2011-6-9 00:21 編輯
回復
1#
emmalee
以下程式放在 Sheet2 內
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRow%
With Target
If .Column = 2 And .Row = 1 Then
Application.EnableEvents = False
With .Parent
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
If iRow < 3 Then iRow = 3
.Range(.[A3], .Cells(iRow, 2)).Clear
End With
Call GetDate(Target)
Application.EnableEvents = True
Target.Select
End If
End With
End Sub
複製代碼
以下程式放在 Module 內
Sub GetDate(ByVal rTar As Range)
Dim iRow%
Dim dDate As Date
Dim vSheet1, rFind As Range
On Error Resume Next
Set vSheet1 = Sheets("Sheet1")
With vSheet1
iRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rFind = Nothing
dDate = rTar.Value
Do Until rFind.Row > 1
Set rFind = Range(.[A2], .Cells(iRow, 1)).Find(dDate, LookIn:=xlValues)
dDate = dDate + 1
Loop
.Range(rFind, .Cells(iRow, 2)).Copy
rTar.Parent.[A3].PasteSpecial Paste:=xlPasteAll
End With
End Sub
複製代碼
作者:
emmalee
時間:
2011-6-9 23:20
本帖最後由 emmalee 於 2011-6-9 23:48 編輯
不好意思，不太懂，是不是貼到巨集就可以用了?
不好意思，是兩個都貼到巨集裡面嗎?但是我無法使用??
另外可以詳解給我聽嗎?謝謝?
作者:
Hsieh
時間:
2011-6-9 23:59
回復
4#
emmalee
[attach]6561[/attach]
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
