Sub 日付3_1()
Dim cnt As Integer
 
Application.StatusBar = ""
#### 下記を測定スタート箇所に貼り付け####
timck = Timer
 
For cnt = 1 To 10
   Call demmyMacro
Next
 
#### 　下記を測定終了箇所に貼り付け　####
MsgBox "マクロ処理時間⇒　" & Timer - timck & "秒"
Application.StatusBar = "マクロ処理時間⇒　" & Timer - timck & "秒"
 
End Sub
-----------------------------------------------------------
Sub demmyMacro()
For j = 2 To 10
    Cells(2, j) = Int((55 - 1 + 1) * Rnd + 1)
    Cells(2, j).Interior.ColorIndex = Cells(2, j)
    Cells(4, 2) = "進捗→" & cnt & "(" & j & "/10)" & "/5"
    Call 時間延長1
Next
End Sub

Sub 時間延長1()
    For t1 = 1 To 1000
        For t2 = 1 To 1000
        Next
    Next
End Sub
-----------------------------------------------------------
Sub 時間延長2()
timck = Timer + 1
   Do
        If Timer > timck Then
             Exit Do
        End If
    DoEvents
   Loop
End Sub
-----------------------------------------------------------
Sub 時間延長3()
 Application.Wait (Now + TimeValue("0:00:01"))
End Sub

Sub 日付3_2()
Dim endr As Integer
    endr = Range("A1000").End(xlUp).Row
 
日付表示形式指定
Range(Cells(3, 1), Cells(endr, 1)).Select
    Selection.Replace What:="年", Replacement:="/", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="月", Replacement:="/", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="日", Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Range("A1").Select
End Sub
------------------------------------------------------
Sub 日付3_3()
Dim endr As Integer, i As Integer
    endr = Range("A1000").End(xlUp).Row
 
日付表示形式指定
Range(Cells(3, 1), Cells(endr, 1)).NumberFormatLocal = "yyyy/m/d;@"
For i = 3 To endr
    myhi = DateValue(Cells(i, 1).Value)
    Cells(i, 1).Value = myhi
Next
End Sub

Sub 日付3_4()
Dim mydat As Date, mysel As Range, myrng As Range
Dim stadd As String, msg As String, rr As Integer
 
    Set mysel = ThisWorkbook.Worksheets("検索データ").Columns(1)
    mydat = "2011/12/7"
 
    With mysel
        Set myrng = .Find(mydat, , , xlWhole)
 
        If Not myrng Is Nothing Then
            stadd = myrng.Address
            Do
                rr = myrng.Row
                msg = msg & rr & "行　　"
 
               Set myrng = .FindNext(myrng)
               If myrng.Address = stadd Then
                    Exit Do
               End If
            Loop
        End If
    End With
    MsgBox "[" & mydat & "]データは" & Chr(10) & msg
End Sub

Sub 日付3_5a()
ThisWorkbook.Worksheets("検索データ").Select
endr = Range("A1000").End(xlUp).Row
    Set mysel = Range(Cells(2, 1), Cells(endr, 6))
    mysel.AutoFilter Field:=1, Criteria1:="平成23年12月7日"
End Sub

Sub 日付3_5b()
ThisWorkbook.Worksheets("検索データ").Select
endr = Range("A1000").End(xlUp).Row
    Set mysel = Range(Cells(2, 1), Cells(endr, 6))
    mysel.AutoFilter Field:=1, Criteria1:=DateValue("平成23年12月7日")
End Sub