VBAで行削除のできない場合がある

次のようなデータがExcel、A列の各行のセルに入っています。
Japan
2-Nov
6-Dec
19-Nov
　・
　・
　・
これらのセルの中味が月日を表示し、且つ、目的の月（今回は9月）以外のセルに該当する行を削除する為のVBAを以下のようにしました。

i = 1
Do Until i = 1000
If IsDate(Cells(i, "A")) And InStr(Cells(i, "A").Value, "2017/11") = False Then
Rows(i).Delete
End If
i = i + 1
Loop

ところが、上記のIf文の条件に一致している筈の一部の行が削除されません。
そこで
Rows(i).Delete を
Cells(i, "B").Interior.ColorIndex = 3 '赤
に置き換えると、条件に合う行のB列のセルの背景色は全て正常に赤となります。
この矛盾の理由が解りません。
ご存知の方、教えて頂ければ幸いです。
宜しくお願い致します。

質問者からの補足コメント

• 皆さんお気づきと思いますが、「目的の月（今回は9月）」は「目的の月（今回は11月）」の間違いでした。失礼しました。

    補足日時：2018/01/24 12:57

No.1 ベストアンサー 回答者： t_fumiaki 回答日時： 2018/01/23 21:18

無条件にi = i + 1としているのが原因

例えばi=10の時、その行が削除されたとすると、
その下は上に全てシフトされるから、削除した行に新しい行が来る訳です。

なのに+1してその1個下から実行するから、シフトして1個上に上がった行は評価対象外になってしまう、・・・って言う事です。


Do Until i = 1000
If IsDate(Cells(i, "A")) And InStr(Cells(i, "A").Value, "2017/11") = False Then
Rows(i).Delete
End If
i = i + 1
Loop

↓

Do Until i = 1000
If IsDate(Cells(i, "A")) And InStr(Cells(i, "A").Value, "2017/11") = False Then
Rows(i).Delete
else
i = i + 1
End If
Loop

本当は1000も変数にして、削除したら、変数の値も-1にすべきですが、まあ結果は同じですが・・・・。

この回答へのお礼

迅速な回答、有り難うございました。
実に基本的な見落としで恥ずかしい限りです。
御指摘のように修正して該当行を正常に削除する事ができました。
今後とも、宜しくお願い致します。

お礼日時：2018/01/24 10:12

No.6 回答者： WindFaller 回答日時： 2018/01/24 16:09

#4の回答者です。

あまり深追いさせても、わけが分からなくなるかもしれませんが、
Excelのセルの表示のプロパティというのは、いくつもあって、

　.Value
　.Text
　.Value2
　.Formula (派生あり)

が挙げられると思います。

>実際の中味は “2017/11/2” となっており、
2018/1/24 と数式バーに出ているものが、.Value 値です。

セルの表示とは一致しないこともあります。これは、変形のDate型の値です。これには、実体がありませんので、これは、Date型として扱うか、Formatでテキストにするか、.Text プロパティで、扱うことで結果が得られるものです。

今回、InStr を使っていましたので、この場合は、文字検索なので.Text がよかろうと思いました。

つまり、書式で表示が替えられているなら、　.Text です。
シリアル値を取得するなら、.Value2です。
Formula も使うことがありますが、シリアル値のString（文字)型です。
Formula は、それほど頻繁ではありません。
このFormula 値は、マクロで検索(Findメソッド)する時に役に立つようです。

そこで、今度はValue値の見本を作ってみました。
a, b, d は。本来は、Date 型です。

Dim i As Long
Const myYear As Long = 2017
Const myMonth As Long = 11
Dim b, a, d
a = DateSerial(myYear, myMonth, 1)
b = DateSerial(myYear, myMonth + 1, 0)　'その月の月末
　For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
　　d = Cells(i, 1).Value
　　If d < a Or d > b Then
　　　　'Rows(i).Delete
　　 End If
Next i

余計なことだと思いましたら、どうか、お見捨てください。

この回答へのお礼

丁重なる御説明、有り難うございました。
書店に並んでいる関連書でもここ迄、深掘りして書かれているものはあまり無いのではと思います。
今後の参考にさせて頂きます。

お礼日時：2018/01/25 22:12

No.5 回答者： tom04 回答日時： 2018/01/24 14:50

No.2です。

＞「目的の月（今回は9月）」は「目的の月（今回は11月）」の間違いでした。

前回のコードの
＞If Month(Cells(i, "A")) <> 9 Then
を
＞If Month(Cells(i, "A")) <> 11 Then

に変更してみてください。
（両コードとも同じ）

※　「今年の11月」以外の場合は
＞If Year(Cells(i, "A")) <> Year(Date) Or Month(Cells(i, "A")) <> 11 Then

としてみてください。

※　Year(Date)
は
2018　でも構いません。m(_ _)m

この回答へのお礼

再度の御指摘、有り難うございました。
後日、試してみます。

お礼日時：2018/01/25 22:09

No.4 回答者： WindFaller 回答日時： 2018/01/24 10:17

せっかく、解答があるのだから、余計なことをいう必要もないかもしれませんが、

行の削除のループは逆さにしていくのが定番です。
他には、Union や Autofilter を使って、一括で削除する方法もあります。

なぜ、色付けはよくて、削除はダメかというと、
一枚の布を手繰り寄せるようなもので、上からやっていくと、その後の方が、どんどん手前にたくし上げられて、正確な位置は変わってきてしまいます。

また、行のように数値で取れて、最後が分かるものにはFor i= ．．to ....Next にするほうが確実です。
今回、あえて、InStr関数をお使いのようなので、この場合は、.Value ではなく、Text 値でないと確実ではありません。

>Japan
>2-Nov
>6-Dec
>19-Nov
とあるなら、

Dim i As Long
　For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
　　If InStr(Cells(i, "A").Text, "Sep") = 0 Then
　　　　'Rows(i).Delete
　　 End If
Next i


ということになりますね。
しかし、IsDate は、難しいところです。もともと、これは、VBAの中だけのものです。
セル上では、複合的(ある意味では、Variant)になっていますから、
これも、本来は、IsDate(Cells(i, "A").Text)が確実だとは思うのですが、その必要性があるかどうかにもなります。InStr でまかなってしまっているようにも思うのです。セルの上で確実に、Date型を調べるには二種類の方法で確かめなくてはならないのですが、見えるものが、そこにあるものであると考えれば、必要ないようにも思います。

この回答へのお礼

成る程、“Text”にした方が良い場合があるのですね。
単にネット上での例を丸写ししただけだったので知りませんでした。
ただ、今回、検索する文字列は年も対象となるので、セルの表記上は “2-Nov” としか表記されていませんが、実際の中味は “2017/11/2” となっており、“Text”では期待した結果にはなりませんでした。
いろいろと貴重なアドバイス、大変勉強になりました。
有り難うございました。

お礼日時：2018/01/24 14:40

No.3 回答者： mike32 回答日時： 2018/01/23 21:51

Rows(i).Deleteで行が削除され、下の行が上に詰められることで、

次の行の判定がされないということでは？

この回答へのお礼

mike32さんの仰るとおりですね。
皆さんの御指摘により無事解決できました。
有り難うございました。

お礼日時：2018/01/24 10:34

No.2 回答者： tom04 回答日時： 2018/01/23 21:40

こんばんは！

No.1さんが回答されている通り、行（列）の削除は最終行（最終列）から遡ってループさせないと
削除した時点で次の行が繰り上がってしまいます。
対象セルが飛び飛びにある場合は問題ありませんが、連続している場合は次の行が飛ばされて処理されます。

↓のコードが一例です。

Sub Sample1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If IsDate(Cells(i, "A")) Then
If Month(Cells(i, "A")) <> 9 Then
Rows(i).Delete
End If
End If
Next i
End Sub

尚、参考程度で、↓のコードは一気に削除する方法です。

Sub Sample2()
Dim i As Long, myRng As Range, myVal As Variant
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
myVal = Cells(i, "A")
If IsDate(Cells(i, "A")) Then
If Month(Cells(i, "A")) <> 9 Then
If myRng Is Nothing Then
Set myRng = Cells(i, "A")
Else
Set myRng = Union(myRng, Cells(i, "A"))
End If
End If
End If
Next i
If Not myRng Is Nothing Then
myRng.EntireRow.Delete
End If
End Sub

どちらでも大丈夫だと思います。

※　データ量が多い場合は　Sample2　の方が速いと思います。m(_ _)m

この回答へのお礼

具体的なサンプルを2つも例示して頂き有り難うございました。
確かに最後尾から遡るという手もあったのですね。
後日、試してみたいと思います。
貴重な時間を割いて頂きお礼申し上げます。

お礼日時：2018/01/24 10:31