VocExcel（単語帳） / VBA Tips
　
　[Key]　エクセル / Excel / VBA /マクロ


<--- 戻る

いろいろな日付パターンの表示（簡易カレンダー作成）

サンプルファイル

いろいろな日付パターンを表示します。　さらに日付情報をもとに簡易カレンダーを作成します。
*処理速度が遅いので注意してください。　

Private Sub DayPart1()

Dim myRow As Long
Dim myMax As Long
Dim i As Long
Dim q As Long
Dim tt As Long


Dim DateStr
Dim DateOne




'前回のデータを削除
Range("A3:IV65536").Select
Selection.Clear



myRow = 3 '開始行は3行目


DateStr = ComboBox1.Text & "/" & ComboBox2.Text & "/" & ComboBox3.Text
DateOne = DateValue(DateStr)

DateStr2 = ComboBox4.Text & "/" & ComboBox5.Text & "/" & ComboBox6.Text
DateMax = DateValue(DateStr2)






tt = 1001 'ID

For i = DateOne To DateMax


'年
Cells(myRow, "E").NumberFormatLocal = "@"
Cells(myRow, "E") = tt


'年
Cells(myRow, "F").NumberFormatLocal = "@"
Cells(myRow, "F") = Format(DateOne, "ggge年")

'年
Cells(myRow, "G").NumberFormatLocal = "@"
Cells(myRow, "G") = Format(DateOne, "yyyy年")

'月
Cells(myRow, "H").NumberFormatLocal = "@"
Cells(myRow, "H") = Format(DateOne, "m")


'月
Cells(myRow, "I").NumberFormatLocal = "@"
Cells(myRow, "I") = "月"




'日にち
Cells(myRow, "J").NumberFormatLocal = "@"
Cells(myRow, "J") = Format(DateOne, "d")


'日にち
Cells(myRow, "K").NumberFormatLocal = "@"
Cells(myRow, "K") = "日"

'曜日 土
Cells(myRow, "L").NumberFormatLocal = "@"
Cells(myRow, "L") = "（" & Format(DateOne, "aaa") & "）"


'標準1A : 2008/5/1 : シリアル値
Cells(myRow, "N") = Format(DateOne, "y/m/d")
Cells(myRow, "N") = DateOne



'標準1C : 2008/05/01 '桁数をそろえる
Cells(myRow, "P").NumberFormatLocal = "@"
Cells(myRow, "P") = Format(DateOne, "yyyy/mm/dd")

'標準1B : 2008/5/1 :
Cells(myRow, "R").NumberFormatLocal = "@"
Cells(myRow, "R") = Format(DateOne, "yy/mm/dd")


'標準2A : 2008年5月1日 '
Cells(myRow, "T").NumberFormatLocal = "@"
Cells(myRow, "T") = Format(DateOne, "yyyy年m月d日")

'標準2B : 2008年05月01日 '
Cells(myRow, "V").NumberFormatLocal = "@"
Cells(myRow, "V") = Format(DateOne, "yyyy年mm月dd日")


'標準2C : 08年5月1日 '
Cells(myRow, "X").NumberFormatLocal = "@"
Cells(myRow, "X") = Format(DateOne, "yy年mm月dd日")


'標準3A : 平成20年年5月1日 '
Cells(myRow, "Z").NumberFormatLocal = "@"
Cells(myRow, "Z") = Format(DateOne, "ggge年m月d日")


'標準2B : 平成20年05月01日 '
Cells(myRow, "AB").NumberFormatLocal = "@"
Cells(myRow, "AB") = Format(DateOne, "gggee年mm月dd日")



'年A : 2008
Cells(myRow, "AD").NumberFormatLocal = "@"
Cells(myRow, "AD") = Format(DateOne, "yyyy")


'年B : 08
Cells(myRow, "AF").NumberFormatLocal = "@"
Cells(myRow, "AF") = Format(DateOne, "yy")


'年C : 2008年
Cells(myRow, "AH").NumberFormatLocal = "@"
Cells(myRow, "AH") = Format(DateOne, "yyyy年")


'年D : 08年
Cells(myRow, "AJ").NumberFormatLocal = "@"
Cells(myRow, "AJ") = Format(DateOne, "yy年")

'年E : 平成
Cells(myRow, "AL").NumberFormatLocal = "@"
Cells(myRow, "AL") = Format(DateOne, "ggg")


'年F : 8 /元号
Cells(myRow, "AN").NumberFormatLocal = "@"
Cells(myRow, "AN") = Format(DateOne, "e")


'年G : 08 /元号
Cells(myRow, "AP").NumberFormatLocal = "@"
Cells(myRow, "AP") = Format(DateOne, "ee")


'年H : 平成8年 /元号
Cells(myRow, "AR").NumberFormatLocal = "@"
Cells(myRow, "AR") = Format(DateOne, "ggge年")

'年H : 平成08年 /元号
Cells(myRow, "AT").NumberFormatLocal = "@"
Cells(myRow, "AT") = Format(DateOne, "gggee年")


'年度
Cells(myRow, "AT").NumberFormatLocal = "@"

Select Case Month(DateOne)

Case 1, 2, 3

myYear = Year(DateOne) - 1
myYear2 = DateValue(myYear & "/1/1")
Cells(myRow, "AV") = Format(myYear2, "ggge年度")

Case Else

Cells(myRow, "AV") = Format(DateOne, "ggge年度")


End Select



'月A : 1 '
Cells(myRow, "AX").NumberFormatLocal = "@"
Cells(myRow, "AX") = Format(DateOne, "m")



'月B : 1月 '
Cells(myRow, "AZ").NumberFormatLocal = "@"
Cells(myRow, "AZ") = Format(DateOne, "mm")


'月C : 1月 '
Cells(myRow, "BB").NumberFormatLocal = "@"
Cells(myRow, "BB") = Format(DateOne, "m月")


'月D : 01月 '
Cells(myRow, "BD").NumberFormatLocal = "@"
Cells(myRow, "BD") = Format(DateOne, "mm月")


'月E : JANUARY '
Cells(myRow, "BF").NumberFormatLocal = "@"
Cells(myRow, "BF") = Format(DateOne, "mmmm")


'月E : JAN '
Cells(myRow, "BH").NumberFormatLocal = "@"
Cells(myRow, "BH") = Format(DateOne, "mmm")


'日A : 1 '
Cells(myRow, "BJ").NumberFormatLocal = "@"
Cells(myRow, "BJ") = Format(DateOne, "d")

'日B : 01 '
Cells(myRow, "BL").NumberFormatLocal = "@"
Cells(myRow, "BL") = Format(DateOne, "dd")


'日C : 1日 '
Cells(myRow, "BN").NumberFormatLocal = "@"
Cells(myRow, "BN") = Format(DateOne, "d日")

'日D : 01日 '
Cells(myRow, "BP").NumberFormatLocal = "@"
Cells(myRow, "BP") = Format(DateOne, "dd日")



'曜日 : 日曜日 '
Cells(myRow, "BR").NumberFormatLocal = "@"
Cells(myRow, "BR") = Format(DateOne, "aaaa")

'曜日 : 日 '
Cells(myRow, "BT").NumberFormatLocal = "@"
Cells(myRow, "BT") = Format(DateOne, "aaa")


'曜日 土
Cells(myRow, "BV").NumberFormatLocal = "@"
Cells(myRow, "BV") = "（" & Format(DateOne, "aaa") & "）"


'曜日 : SUN '
Cells(myRow, "BX").NumberFormatLocal = "@"
Cells(myRow, "BX") = Format(DateOne, "ddd")

'曜日 : SUNDAY '
Cells(myRow, "BZ").NumberFormatLocal = "@"
Cells(myRow, "BZ") = Format(DateOne, "dddd")




'その他 1 / 特殊日付 1日 = m月d日 / 2日目 = ""
If Format(DateOne, "d") = "1" Then
'月
Cells(myRow, "CB").NumberFormatLocal = "@"
Cells(myRow, "CB") = Format(DateOne, "m月d日")

Else

If myRow = "3" Then
Cells(myRow, "CB").NumberFormatLocal = "@"
Cells(myRow, "CB") = Format(DateOne, "m月d日")

Else

Cells(myRow, "CB").NumberFormatLocal = "@"
Cells(myRow, "CB") = Format(DateOne, "d")
End If

End If


'その他 2 / 特殊月 1日 = m / 2日 = ""
If Format(DateOne, "d") = "1" Then
'月
Cells(myRow, "CD").NumberFormatLocal = "@"
Cells(myRow, "CD") = Format(DateOne, "m月")

Else

If myRow = "3" Then
Cells(myRow, "CD").NumberFormatLocal = "@"
Cells(myRow, "CD") = Format(DateOne, "m月")

Else

Cells(myRow, "CD").NumberFormatLocal = "@"
End If

End If






tt = tt + 1

myRow = myRow + 1
DateOne = DateOne + 1


Next



Cells(3, "M").Select





End Sub
--