- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
8#
發表於 2015-12-24 09:19
| 只看該作者
試試VBA:- Sub 簡易橫式年曆()
- Dim yy As Integer, mm As Integer, dd As Integer, d2 As Integer, w As Integer
- yy = 2016
- [B2:AF47] = ""
- [B2:AF47].Interior.ColorIndex = xlNone
- For mm = 1 To 12
- d2 = Day(DateSerial(yy, mm + 1, 0))
- For dd = 1 To d2
- Cells(mm * 4 - 1, dd + 1) = DateSerial(yy, mm, dd)
- w = Weekday(Cells(mm * 4 - 1, dd + 1), vbSunday)
- Cells(mm * 4 - 2, dd + 1).NumberFormatLocal = "d"
- Cells(mm * 4 - 2, dd + 1).FormulaR1C1 = "=RIGHT(TEXT(R[1]C,""aaa""))"
- If w = 1 Then
- Cells(mm * 4 - 2, dd + 1).Font.ColorIndex = 3
- ElseIf w = 7 Then
- Cells(mm * 4 - 2, dd + 1).Font.ColorIndex = 5
- Else
- Cells(mm * 4 - 2, dd + 1).Font.ColorIndex = 1
- End If
- Next
- Next
- End Sub
- Sub 漆後資訊()
- Dim shA As Worksheet
- Dim LstR As Integer, I As Integer, J As Integer, eDay As Integer, mNUM As Integer
- Dim Rng As Range, SD As Range, ED As Range, Scel As Range, Ecel As Range
- Set shA = Sheets("A")
- Set Rng = [B3:AF47]
- Rng.Interior.ColorIndex = xlNone
- LstR = shA.[M4].End(xlDown).Row
- For I = 4 To LstR
- Set SD = shA.Cells(I, 13) 'Start Date
- Set ED = shA.Cells(I, 14) 'End Date
- If SD.Value > ED.Value Then
- MsgBox "起始日期：" & SD.Value & " > 終止日期：" & ED.Value & ", 請查明再繼續!!", vbOKOnly
- Exit For
- End If
- Set Scel = Rng.Find(SD, Lookat:=xlWhole) '在年曆中尋找 Start Date
- If Scel Is Nothing Then
- MsgBox "查無此日期:" & SD & ", 請查明再繼續!!", vbOKOnly
- Exit For
- End If
- Set Ecel = Rng.Find(ED, Lookat:=xlWhole) '在年曆中尋找 End Date
- If Ecel Is Nothing Then
- MsgBox "查無此日期:" & ED & ", 請查明再繼續!!", vbOKOnly
- Exit For
- End If
-
- If Scel.Row = Ecel.Row Then '同一月
- Scel.Resize(1, Ecel.Column - Scel.Column + 1).Interior.ColorIndex = 6
- ElseIf Ecel.Row - Scel.Row >= 4 Then '跨前後月
- eDay = Day(DateSerial(Year(Scel), Month(Scel) + 1, 0))
- Scel.Resize(1, eDay - Scel.Column + 2).Interior.ColorIndex = 6
- Cells(Ecel.Row, "B").Resize(1, Ecel.Column - 1).Interior.ColorIndex = 6
- If Ecel.Row - Scel.Row > 4 Then '跨兩三月
- For J = Scel.Row + 4 To Ecel.Row - 4 Step 4
- Cells(J, "B").Resize(1, Cells(J, "B").End(xlToRight).Column - 1).Interior.ColorIndex = 6
- Next
- End If
- End If
- Next
- End Sub
|
|
發表於 2015-12-23 18:35
| 
