Sub Replace(ByVal oldDate As Date, ByVal newDate As Date)
Dim lngYLine As Long
Dim intXLine As Integer
Dim objFind As Object
Dim strAddress As String
Set objFind = Cells.Find(oldDate)
If Not objFind Is Nothing Then
strAddress = objFind.Address
Do While Not objFind Is Nothing
lngYLine = objFind.Cells.Row
intXLine = objFind.Cells.Column
Cells(lngYLine, intXLine).Value = newDate
Set objFind = Cells.FindNext(objFind)
If objFind Is Nothing Then
Exit Do
End If
Loop
Else
MsgBox CStr(oldDate) + " 見つかりませんでした"
End If
End Sub