[[20200907220908]]　『VBA　本日日付以外があった場合、行削除』（ピノ）　ページの最後に飛ぶ

『VBA　本日日付以外があった場合、行削除』（ピノ）

いつもお世話になっております。

B列に本日日付以外があった場合に削除したいのですが、
本日日付の部分の構文が色々試してもうまくいかず、、
教えていただけないでしょうか。
なお、日付はyyyymmdd表記です。

Sub データ整備()

    Dim LR As Long
    Dim i As Long

'データの最終行取得
LR = Cells(Rows.Count, "A").End(xlUp).Row

'B列に本日日付以外があったら、行削除
For i = 2 To LR

    If Cells(i, 2) <> DateValue(Now(Format(Date, "yyyymmdd"))) Then
       Range(i & ":" & i).Delete
    End If
Next i

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

＞日付はyyyymmdd表記
実際のセルの値はなんですか？

想像するに、20200907などの数値じゃありませんか？
その場合、↓はどういう結果を期待していたのか、おかしな点がないか、もう一度考えてみてはいかがでしょうか。

 DateValue(Now(Format(Date, "yyyymmdd")))

（もこな２） 2020/09/07(月) 22:26

もこな2様
いつもありがとうございます。
はい、20200907のような、形式になります。

もう一度再検証してみます。有難う御座います。

（ピノ） 2020/09/07(月) 22:58

 日付が入っているというセルを選択した状態で、下記を実行したらどのように表示されるでしょうか。
 イミディエイトウィンドウが表示されていれば、そこからコピペできます。

 Sub CheckDate()
    MsgBox "FORMAT = [" & Selection.NumberFormatLocal & "]" & vbNewLine _
    & "VALUE = [" & Selection.Value & "]" & vbNewLine _
    & "TEXT = [" & Selection.Text & "]"

    Debug.Print "FORMAT = [" & Selection.NumberFormatLocal & "]" & vbNewLine _
    & "VALUE = [" & Selection.Value & "]" & vbNewLine _
    & "TEXT = [" & Selection.Text & "]"
 End Sub
（QS） 2020/09/08(火) 00:18

結局解決したんですかね？とりあえず・・・

■１
＞yyyymmdd表記です。
例えば、今日マクロを動かしたとして、20200908という"数字"を得たいなら↓でよいでしょう。

 Format(Date, "yyyymmdd")

 ※忘れちゃったなら↓を再読してください。
[[20200806214553]]　『過去日付ファイルを開きたい』（ピノ）
[[20200806235620]]　『ファイル名が可変日付のファイルをフォルダ移動したい』（ピノ）

そもそも↓だと型が一致しないというエラーになりませんか？

 DateValue(Now(Format(Date, "yyyymmdd")))

■２

 For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row

↑について、行全体の削除を行うと【上】にズレます。
なので、１行ずつ処理するなら【下】から順にみていかないとダメです

■３
ふまえて、こんな感じでよいでしょう。

    Sub さんぷる壱()
        Dim i As Long
        Dim 検索値 As Long

        検索値 = Format(Date, "yyyymmdd")
        MsgBox 検索値

        'B列に本日日付以外があったら、行削除
        For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
            Stop
            If Cells(i, 2).Value <> 検索値 Then Rows(i).Delete
        Next i
    End Sub

■４
ちなみに逐一削除するのではなく、まとめて最後に１回だけ削除するというアプローチもあるとおもいます。
その場合、上から見ていっても問題はありません。

    Sub さんぷる弐()
        Dim i As Long
        Dim 検索値 As Long
        Dim bufRNG As Range

        検索値 = Format(Date, "yyyymmdd")
        MsgBox 検索値

        Stop

        With ActiveSheet
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 1
                If .Cells(i, "B").Value <> 検索値 Then
                    If bufRNG Is Nothing Then
                        Set bufRNG = .Cells(i, "B")
                    Else
                        Set bufRNG = Union(bufRNG, .Cells(i, "B"))
                    End If
                End If
            Next i
        End With

        If Not bufRNG Is Nothing Then bufRNG.EntireRow.Delete

    End Sub

（もこな２） 2020/09/08(火) 08:09

QS様
有難う御座います。
いただいたカードでイミディエイトウィンドウには、セルの内容が表示されました。
日付の取り方がそもそも違っていたようで、もこな2様に頂いた構文を参考に、書き直してみます。

もこな2様
何度もすみません。
日付の取り方は、以前教えていただいたにも関わらず、変な書き方をしてしまい、すみませんでした。
構文まで、すみません、有難うございます。
一行ずつ処理する場合は、下からの処理が必要なんですね、勉強になりました。

■4の構文でやりたいことができました。
■3は試してみましたが、本日日付の有無に関わらず、すべての行が下から削除されてしまったため…もう少し検証してみたいと思います！！

（ピノ） 2020/09/08(火) 18:28

 >いただいたカードでイミディエイトウィンドウには、セルの内容が表示されました。
 ということばではなく、実際に表示された内容を教えてほしかったのですが。

 セルが文字列か、数値か、日付かで処理対応方法が変わるので。
（QS） 2020/09/09(水) 11:26

コメント返信：

[ 一覧(最新更新順) ]

[[20200907220908]] 『VBA 本日日付以外があった場合、行削除』（ピノ） ページの最後に飛ぶ

[[20200907220908]]　『VBA　本日日付以外があった場合、行削除』（ピノ）　ページの最後に飛ぶ