スポンサーサイト

--–--–-- (--) --:--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

選択したシートの式を削除する

2018–01–10 (Wed) 23:18
Sub 複数シート()
On Error Resume Next
Application.ScreenUpdating = False
Dim sh As Object
Dim kazu As Long
kazu = ActiveWindow.SelectedSheets.Count
Dim ichi As Variant
Dim i As Long
Dim MaxRow As Long
Dim MaxCol As Long
i = 0
ReDim ichi(kazu - 1)
For Each sh In ActiveWindow.SelectedSheets
ichi(i) = sh.Name
i = i + 1

Next sh
ActiveWindow.SelectedSheets(1).Select
For i = 0 To UBound(ichi)
MaxRow = 0
MaxCol = 0
Worksheets(ichi(i)).Activate
With Worksheets(ichi(i)).UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Worksheets(ichi(i)).Range("a1", Cells(MaxRow, MaxCol)).Value = Worksheets(ichi(i)).Range("a1", Cells(MaxRow, MaxCol)).Value
Next
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
スポンサーサイト

時間以上で色を変更する

2018–01–09 (Tue) 22:56
Sub 一時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""1:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 一時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""1:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 二時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""2:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 二時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""2:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub


Sub 三時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""3:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 三時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""3:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 四時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""4:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 四時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""4:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 五時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""5:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 五時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""5:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub


Sub 六時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""6:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 六時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""6:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub
Sub 七時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""7:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 七時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""7:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 八時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""8:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 八時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""8:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 九時間以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""9:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

Sub 九時間半以上で赤太字にする()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""9:30"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub


百以上で赤太字にする

2018–01–09 (Tue) 22:52
Sub 百以上で赤太字にする()
'
' Macro1 Macro
'

'
Application.WindowState = xlMaximized
Application.WindowState = xlNormal
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=100"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

時間によって色を変えるマクロ

2018–01–03 (Wed) 16:57

Sub 時間指定()
'
' Macro4 Macro
'

'
Application.ScreenUpdating = False

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=TIMEVALUE(""2:00"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub

日付表示変更

2017–12–12 (Tue) 15:35
全て標準モジュールに貼り付ける形となります。

Dim r As Range
Dim i As Long
Dim k As Variant
Dim kazu As Long
Dim ikou As Variant



Sub 範囲指定1()
For kazu = 1 To UBound(k)
For kazu2 = 1 To UBound(k, 2)
If k(kazu, kazu2) <> "" Then
k(kazu, kazu2) = StrConv(k(kazu, kazu2), vbNarrow)
k(kazu, kazu2) = Replace(k(kazu, kazu2), ".", "/")
k(kazu, kazu2) = k(kazu, kazu2)
End If
Next
Next
End Sub
Sub 範囲指定2()
For i = 1 To UBound(ikou)
For j = 1 To LBound(ikou)
If ikou(i, j) = "" Then
Else
ikou(i, j) = StrConv(ikou(i, j), vbNarrow)
ikou(i, j) = Replace(ikou(i, j), ".", "/")
ikou(i, j) = ikou(i, j)
End If
Next
Next
End Sub



Sub 和暦ge_m_d()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge.m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge.m.d"
Selection.Value = Selection.Value
End If

On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年m月d日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge年m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge年m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年m月d日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge年m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge年m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_m_d()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge.m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge.m.d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge_mm_dd()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge.mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge.mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年mm月dd日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge年mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge年mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年mm月dd日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge年mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge年mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_mm_dd()

On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge.mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge.mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Sub 和暦gee_m_d()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee.m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee.m.d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gee年m月d日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee年m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee年m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee年m月d日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee年m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee年m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee_m_d()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee.m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee.m.d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gee_mm_dd()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee.mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee.mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gee年mm月dd日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee年mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee年mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee年mm月dd日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee年mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee年mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee_mm_dd()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee.mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee.mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_m_d()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy.m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy.m.d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyyスラmスラd()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy/m/d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy/m/d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年m月d日()
On Error Resume Next
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy年m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy年m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_mm_dd()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy.mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy.mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyyスラmmスラdd()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy/mm/dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy/mm/dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy年mm月dd日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy年mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy年mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Sub mm_dd()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm.dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm.dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mmスラdd()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm/dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm/dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月dd日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm月dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm月dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m_d()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m.d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m.d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mスラd()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m/d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m/d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub m月d日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m月d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m月d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ggge_m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦gee_m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee"".""m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee"".""m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gee年m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee""年""m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee""年""m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee年m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee""年""m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee""年""m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦gggee_m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee"".""m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee"".""m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦gee_mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee"".""mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee"".""mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gee年mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee""年""mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee""年""mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee年mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee""年""mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee""年""mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦gggee_mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee"".""mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee"".""mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmスラd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""m""/""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""m""/""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy_mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmmスラdd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""mm""/""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""mm""/""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mm_dd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm"".""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm"".""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mmスラdd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""/""dd""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""/""dd""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月dd日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""月""dd""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""月""dd""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m_d曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m"".""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m"".""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mスラd曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""/""d""""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""/""d""""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m月d日曜日略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""月""d""日""(aaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""月""d""日""(aaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge_m_d曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""m"".""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""m"".""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年m月d日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""m""月""d""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""m""月""d""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年m月d日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""m""月""d""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""m""月""d""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ggge_m_d曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""m"".""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""m"".""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_mm_dd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""mm"".""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""mm"".""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年mm月dd日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""mm""月""dd""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""mm""月""dd""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年mm月dd日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""mm""月""dd""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""mm""月""dd""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_mm_dd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""mm"".""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""mm"".""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_m_d曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""m"".""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""m"".""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmスラd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""m""/""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""m""/""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
Sub 西暦yyyy年m月d日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""m""月""d""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""m""月""d""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy_mm_dd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""mm"".""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""mm"".""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmmスラdd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""mm""/""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""mm""/""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年mm月dd日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""mm""月""dd""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""mm""月""dd""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mm_dd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm"".""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm"".""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mmスラdd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""/""dd""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""/""dd""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月dd日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""月""dd""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""月""dd""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m_d曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m"".""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m"".""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mスラd曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""/""d""""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""/""d""""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m月d日曜日()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""月""d""日""(aaaa)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""月""d""日""(aaaa)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Sub 和暦ge_m_d曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""m"".""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""m"".""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年m月d日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""m""月""d""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""m""月""d""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年m月d日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""m""月""d""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""m""月""d""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ggge_m_d曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""m"".""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""m"".""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_mm_dd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""mm"".""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""mm"".""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年mm月dd日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""mm""月""dd""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""mm""月""dd""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年mm月dd日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""mm""月""dd""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""mm""月""dd""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_mm_dd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""mm"".""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""mm"".""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_m_d曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""m"".""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""m"".""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmスラd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""m""/""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""m""/""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年m月d日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""m""月""d""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""m""月""d""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy_mm_dd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""mm"".""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""mm"".""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmmスラdd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""mm""/""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""mm""/""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年mm月dd日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""mm""月""dd""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""mm""月""dd""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mm_dd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm"".""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm"".""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mmスラdd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""/""dd""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""/""dd""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月dd日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""月""dd""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""月""dd""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m_d曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m"".""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m"".""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mスラd曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""/""d""""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""/""d""""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m月d日曜日英略()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""月""d""日""(ddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""月""d""日""(ddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_m_d曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""m"".""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""m"".""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年m月d日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""m""月""d""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""m""月""d""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年m月d日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""m""月""d""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""m""月""d""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ggge_m_d曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""m"".""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""m"".""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 和暦ge_mm_dd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"".""mm"".""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"".""mm"".""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ge年mm月dd日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge""年""mm""月""dd""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge""年""mm""月""dd""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge年mm月dd日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge""年""mm""月""dd""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge""年""mm""月""dd""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 和暦ggge_mm_dd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"".""mm"".""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"".""mm"".""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 西暦yyyy_m_d曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""m"".""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""m"".""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmスラd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""m""/""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""m""/""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年m月d日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""m""月""d""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""m""月""d""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy_mm_dd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"".""mm"".""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"".""mm"".""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyyスラmmスラdd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""/""mm""/""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""/""mm""/""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub 西暦yyyy年mm月dd日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy""年""mm""月""dd""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy""年""mm""月""dd""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mm_dd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm"".""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm"".""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mmスラdd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""/""dd""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""/""dd""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月dd日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm""月""dd""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm""月""dd""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m_d曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m"".""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m"".""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mスラd曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""/""d""""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""/""d""""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m月d日曜日英()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m""月""d""日""(dddd)"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m""月""d""日""(dddd)"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Sub yyyyのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub yyのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yy"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yy"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub yyyy年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yyyy年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yyyy年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub yy年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "yy年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "yy年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub geのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub gggeのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub ge年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ge年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ge年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub ggge年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggge年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggge年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub geeのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub gggeeのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub gee年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gee年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gee年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub gggee年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "gggee年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub gのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "gggee年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "g"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub gggのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ggg"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ggg"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub eのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "e"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "e"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub eeのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ee"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ee"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub e年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "e年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "e年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub ee年のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "ee年"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "ee年"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub mのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mmのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub m月のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "m月"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "m月"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub mm月のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "mm月"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "mm月"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub dのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "d"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "d"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub ddのみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "dd"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "dd"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub d日のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "d日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "d日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub dd日のみ()
Application.ScreenUpdating = False
Set r = Selection
If r.Areas.Count <> 1 Then
For i = 1 To r.Areas.Count
k = r.Areas.Item(i)
Call 範囲指定1
r.Areas.Item(i) = k
r.Areas.Item(i).NumberFormatLocal = "dd日"
r.Areas.Item(i).Value = r.Areas.Item(i).Value
Next
Else
ikou = Selection.Value
If Selection.Count <> 1 Then
Call 範囲指定2
Else
If ikou = "" Then
Else
ikou = StrConv(ikou, vbNarrow)
ikou = Replace(ikou, ".", "/")
ikou = ikou.Value
End If
End If
Selection.Value = ikou
Selection.NumberFormatLocal = "dd日"
Selection.Value = Selection.Value
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Sub 標準()

On Error Resume Next

Selection.NumberFormatLocal = "G/標準"

On Error GoTo 0
End Sub

 | HOME |  次へ »

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。