Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

73666 / 76732

←次へ　｜　前へ→


	【7540】Re:日付の検索をしたいんですが。

Jaka - 03/9/8(月) 14:29 -


	引用なし

	パスワード

こんな感じでしょうか？

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

0 hits

▼

【7459】日付の検索をしたいんですが。 haru 03/9/5(金) 13:30