- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
¸Õ¸Õ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 º£«á¸ê°T()
- 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 "°_©l¤é´Á¡G" & SD.Value & " > ²×¤î¤é´Á¡G" & ED.Value & ", ½Ð¬d©ú¦AÄ~Äò!!", vbOKOnly
- Exit For
- End If
- Set Scel = Rng.Find(SD, Lookat:=xlWhole) '¦b¦~¾ä¤¤´M§ä Start Date
- If Scel Is Nothing Then
- MsgBox "¬dµL¦¹¤é´Á:" & SD & ", ½Ð¬d©ú¦AÄ~Äò!!", vbOKOnly
- Exit For
- End If
- Set Ecel = Rng.Find(ED, Lookat:=xlWhole) '¦b¦~¾ä¤¤´M§ä End Date
- If Ecel Is Nothing Then
- MsgBox "¬dµL¦¹¤é´Á:" & ED & ", ½Ð¬d©ú¦AÄ~Äò!!", vbOKOnly
- Exit For
- End If
-
- If Scel.Row = Ecel.Row Then '¦P¤@¤ë
- Scel.Resize(1, Ecel.Column - Scel.Column + 1).Interior.ColorIndex = 6
- ElseIf Ecel.Row - Scel.Row >= 4 Then '¸ó«e«á¤ë
- 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 '¸ó¨â¤T¤ë
- 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
½Æ»s¥N½X
|
|