Excel VBA質問箱 IV

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

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


4207 / 13646 ツリー ←次へ | 前へ→

【57898】同じ値が数行以上続いたら行削除 tak 08/9/19(金) 15:27 質問[未読]
【57899】Re:同じ値が数行以上続いたら行削除 kanabun 08/9/19(金) 15:54 発言[未読]
【57903】Re:同じ値が数行以上続いたら行削除 tak 08/9/19(金) 16:59 お礼[未読]
【57901】Re:同じ値が数行以上続いたら行削除 kanabun 08/9/19(金) 16:24 発言[未読]
【57902】Re:同じ値が数行以上続いたら行削除 kanabun 08/9/19(金) 16:49 発言[未読]

【57898】同じ値が数行以上続いたら行削除
質問  tak  - 08/9/19(金) 15:27 -

引用なし
パスワード
   「5行以上同じ値が続いていたら、その行はすべて削除」という作業をVBAで挑戦したいのですが、「型が一致しません」というエラーが出てしまい、うまく動作しません。(下のプログラム文で11行目のところでエラーが出ます)
ローカルウィンドウで見る限りは、top、under、それぞれにちゃんと値は入っているように見えるのですが、エラーの原因はなんでしょうか。
不細工なプログラム文で恐縮ですが、ご教授お願い致します。

1 Sub test()
2 Dim top, under, n As Integer

3 n = 0
 
4 Const 列 = 1
5  Cells(Rows.Count, 列).End(xlUp).Select          '1列目の入力セルの最下行を選択
6  under = ActiveCell.row                 'underにアクティブセルの行番号を代入
 
7    For top = Cells(Rows.Count, 列).End(xlUp).row To 2 Step -1  '最下行から1行ずつ上昇
8    n = n + 1                      'カウントをプラス1
   
9    If Cells(top, 列) <> Cells(top - 1, 列) Then     '一つ上のセルと違う値のとき
10     If n >= 5 Then                   '同内容のセルが5行以上あったならば
11       Rows("top:under ").Delete shift:=xlUp      'topからunderまで行削除
12       n = 0                     'カウントを0に戻す
13       under = top - 1                'underの行番号を次の値まで移動
14       Cells(under, 列).Select             'セルの位置も移動
15     Else                        '同内容のセルが5行未満だったら
16       n = 0
17       under = top - 1
18       Cells(under, 列).Select
19     End If
20    End If

21  Next top

22 End Sub


※変数について

 ┌ A…top
   A
 n  A
   A
   A
 └ A…under
   B
   B
   B

【57899】Re:同じ値が数行以上続いたら行削除
発言  kanabun  - 08/9/19(金) 15:54 -

引用なし
パスワード
   ▼tak さん:

> 「型が一致しません」というエラーが出てしまい、うまく動作しません。(下のプログラム文で11行目のところでエラーが出ます)
>、top、under、それぞれにちゃんと値は入っているように見えるのですが、
> エラーの原因はなんでしょうか。


>11       Rows("top:under ").Delete shift:=xlUp

とりあえず、変数は "" で囲わないこと。

Rows(top & ":" & under).Delete

【57901】Re:同じ値が数行以上続いたら行削除
発言  kanabun  - 08/9/19(金) 16:24 -

引用なし
パスワード
   あと、こんなふうにも書けるんでは、と思いましたので、投稿
しておきます。
比較する2つのセルの値を変数に入れて処理しています。

Sub test2()
 Dim i As Long, under As Long, n As Long
 Const 列 = 1
 Dim v1 As String, v2 As String

 '1列目の入力セルの最下行番号
 under = Cells(Rows.Count, 列).End(xlUp).Row

 v2 = Cells(under, 列).Value
 For i = under - 1 To 1 Step -1 '(最下行-1)から1行ずつ上昇
   v1 = Cells(i, 列).Value
   If v1 = v2 Then
     n = n + 1 - (n = 0)
     If n >= 5 Then
       With Rows(i).Resize(5)
         .Select '.Delete
         Stop
       End With
       n = 0
     End If
   Else
     n = 0
   End If
   v2 = v1
 Next i

End Sub

(★チェックのため、削除行を Select して Stop しています。
 続行するには [F5]キーを押してください。
 実用時には、 .Select を .Delete に代え、 Stop をコメント化してください)

【57902】Re:同じ値が数行以上続いたら行削除
発言  kanabun  - 08/9/19(金) 16:49 -

引用なし
パスワード
   ▼tak さん:

すみません。仕様を誤解してました m(__)m

>「5行以上同じ値が続いていたら、その行はすべて削除」

ということでしたので、上のでは仮に動いたとしても、すべて削除は
してくれません。
とりあえず、以下に修正します。

Sub test3()
 Dim i As Long, under As Long, n As Long
 Const 列 = 1
 Dim v1 As String, v2 As String

 '1列目の入力セルの最下行番号
 under = Cells(Rows.Count, 列).End(xlUp).Row

 v2 = Cells(under, 列).Value
 For i = under To 2 Step -1 '最下行から1行ずつ上昇
   v1 = Cells(i - 1, 列).Value
   If v1 <> v2 Then
     GoSub CheckCount
   Else
     n = n + 1 - (n = 0)
   End If
   v2 = v1
 Next i
 GoSub CheckCount
Exit Sub
 
CheckCount:
 If n >= 5 Then
   With Rows(i).Resize(n)
     .Select '.Delete
     Stop
   End With
   n = 0
 End If
 Return
 
End Sub

【57903】Re:同じ値が数行以上続いたら行削除
お礼  tak  - 08/9/19(金) 16:59 -

引用なし
パスワード
   ▼kanabun さん:

早速のご回答、ありがとうございます。
おかげさまでプログラムを完成させることができました。

スマートなプログラム文も記載していただいて、とても勉強になりました。
今後のプログラミングの参考にさせて頂きます。

ご丁寧にありがとうございました。

4207 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free