連続した値の、間の値を削除したい。

すみません、誰か教えていただけませんか。
A列に値が入力されていて、連続の値が３つ以上値が連続
していたら間の値を削除したいのですが、どのようにしたら
良いのでしょうか。
すみませんが、教えていただけませんでしょうか。

下記の様に記述しましたが、うまくいきません。


リンゴ 1
リンゴ 2
リンゴ 3
リンゴ 4
ばなな 5
ばなな 6
ばなな 7
みかん 8
みかん 9
みかん 10
みかん 11
パイナップル12
パイナップル13
イチゴ 14
イチゴ 15
イチゴ 16

リンゴ 1
リンゴ 4
ばなな 5
ばなな 7
みかん 8
みかん 11
パイナップル12
パイナップル13
イチゴ 14
イチゴ 16


Sub 値削除テスト()
Dim Te As Long
Dim Re As Long
Te = Cells(Rows.Count, 1).End(xlUp).Row

For Re = 1 To Te
If Cells(Re, 1).Value = Cells(Re, 1).Offset(1, 0).Value And Cells(Re, 1).Value = Cells(Re, 1).Offset(2, 0).Value Then
Cells(Re, 1).Offset(1, 0).Delete (xlUp)
End If
Next Re
End Sub

宜しくお願いします。

No.1 ベストアンサー 回答者： kmetu 回答日時： 2014/01/15 21:41

削除する場合、上からいくと削除されたときに評価する行が1行飛びますからうまくいきません。

10行を削除して11行目が10行目に上がってきたとき、次の評価を12行目から上がってきた11行目に対して行おうとするので元の11行目(10行目になってしまっている)が評価されずに残ってしまいます。

ですので、下から評価して削除していくようにするとうまくいきます。

For Re = Te To 1 Step -1

に変更してください。

この回答へのお礼

kmetu様

ありがとうございました。
すぐに、解決する事が出来ました。

お礼日時：2014/01/15 21:59