- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 255
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-25
              
|
5#
發表於 2010-6-14 14:28
| 只看該作者
回復 4# ounmaxz - Sub nn()
- Dim Rng As Range, A As Range, Ar(), Ay()
- With Sheet2
- Ut = .[P5].Value
- Set Rng = .Range(.[N5], .[N65536].End(xlUp)) '設置比對的標準區域
- With Sheet1
- ReDim Preserve Ay(0)
- Ay(0) = .[A1].Resize(, 14).Value
- For Each A In .Range(.[A1], .[A65536].End(xlUp)) '在sheet1的d欄資料循環
- If Not Rng.Find(A, lookat:=xlWhole) Is Nothing And A.Offset(, 13) = "加班" Then '如果標準區找到d欄的值
- ReDim Preserve Ar(s)
- ReDim Preserve Ay(s + 1)
- Ar(s) = Array(Ut, A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
- Ay(s + 1) = A.Resize(, 14).Value
- s = s + 1
- End If
- Next
- End With
- .[A5:I20] = ""
- Sheet3.Cells = "" '清空Sheet3內容
- If s > 0 Then .[A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar)): _
- Sheet3.[A1].Resize(s + 1, 14) = Application.Transpose(Application.Transpose(Ay)) '把Sheet1符合的列複製到Sheet3的A1
- End With
- End Sub
- Sub yy() '填滿日期
- y = InputBox("輸入西元年度", , 2010)
- With Sheet1
- Ar = .[B2:C17].Value
- r = 2
- For i = DateValue(y & "/1/1") To DateValue(y & "/12/31")
- .Cells(r, 1).Resize(16, 1) = i
- .Cells(r, 2).Resize(16, 2) = Ar
- r = r + 16
- Next
- End With
- End Sub
|
|
發表於 2010-6-10 16:09
| 
