| |
こんな感じでしょうか？
Sub Macth日付()
ib$ = InputBox("コピーしたい日付を入力して下さい。", "日付", Cells(1, 1).Text)
If ib$ = "" Then Exit Sub
ro = 1
Do
sss = Application.Match(CDbl(CDate(ib$)), Range("A" & ro & ":A65536"), 0)
If IsError(sss) = True Then Exit Do
sss = sss + ro - 1
Cells(sss, 1).Select
ii = ii + 1
Cells(ii, 1).Interior.ColorIndex = 3
ro = sss + 1
Loop
End Sub
Sub Find日付()
Dim 値 As Variant, FCel As Range, FistAd As String
日付 = InputBox("検索したい日付の入ったセルを黄色くします。" & Chr(13) & _
"文字を入力して下さい。", "日付の検索")
If 日付 = "" Then
End
End If
日付H = DateValue(日付)
If Err <> 0 Then
MsgBox "日付エラー"
End
End If
検索範囲 = "A1:A65536"
Application.ScreenUpdating = False
With ActiveSheet.Range(検索範囲)
Set FCel = .Find(日付H, LookAt:=xlWhole)
If Not FCel Is Nothing Then
FistAd = FCel.Address
Do
FCel.Interior.ColorIndex = 6
FCel.Select
Set FCel = .FindNext(FCel)
Loop Until FistAd = FCel.Address
Else
MsgBox "「" & 日付H & "」の入ったセルは、全くありません。", vbCritical
End If
End With
Application.ScreenUpdating = True
Set FCel = Nothing
End Sub
|
|
