1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: |
Public Sub CalcWeek()
Dim nYear As Integer Dim nMonth As Integer Dim nDay As Integer nYear = Cells(2, 1).Value nMonth = Cells(2, 2).Value nDay = Cells(2, 3).Value Dim arWeek(0 To 6) As String arWeek(0) = "日" arWeek(1) = "月" arWeek(2) = "火" arWeek(3) = "水" arWeek(4) = "木" arWeek(5) = "金" arWeek(6) = "土" Cells(2, 4).Value = arWeek(Zeller(nYear, nMonth, nDay)) End Sub Private Function Zeller(yyyy As Integer, mm As Integer, dd As Integer) As Integer If mm = 1 Or mm = 2 Then yyyy = yyyy - 1 mm = mm + 12 End If Zeller = (yyyy + yyyy \ 4 - yyyy \ 100 + yyyy \ 400 + (13 * mm + 8) \ 5 + dd) Mod 7 End Function |