Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5989 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【47783】行の削除について 初心者 07/3/22(木) 15:38 質問[未読]
【47784】Re:行の削除について ウッシ 07/3/22(木) 15:43 回答[未読]
【47786】Re:行の削除について りん 07/3/22(木) 15:46 回答[未読]
【47788】Re:行の削除について 初心者 07/3/22(木) 15:59 お礼[未読]
【47814】Re:行の削除について tami 07/3/22(木) 22:17 質問[未読]
【47815】Re:行の削除について ウッシ 07/3/22(木) 22:44 発言[未読]
【47816】Re:行の削除について tami 07/3/23(金) 7:16 お礼[未読]
【47834】Re:行の削除について りん 07/3/23(金) 12:56 回答[未読]
【47783】行の削除について
質問  初心者 E-MAIL  - 07/3/22(木) 15:38 -
引用なし
パスワード
   A1からA700までの欄で空白なら、色をつけて行を削除したいのですが
色をつけるまでしかできませんでした。
行を削除するマクロを教えて頂けますでしょうか。
御忙しい所大変申し訳ございませんが、
宜しくお願い致します。

Range("A1:A700").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 5
【47784】Re:行の削除について
回答  ウッシ  - 07/3/22(木) 15:43 -
引用なし
パスワード
   こんにちは

削除したら色を付ける意味が無いと思うのですが？

Range("A1:A700").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

空白が無いとエラーになりますよ。
【47786】Re:行の削除について
回答  りん E-MAIL  - 07/3/22(木) 15:46 -
引用なし
パスワード
   ▼初心者 さん：
>A1からA700までの欄で空白なら、色をつけて行を削除したいのですが
>色をつけるまでしかできませんでした。
>行を削除するマクロを教えて頂けますでしょうか。
>御忙しい所大変申し訳ございませんが、
>宜しくお願い致します。

削除をするなら色づけはいらないのでは？
EntireRowで範囲を行全体に拡張します。

Sub test()
　 Dim r1 As Range
　 On Error Resume Next　'エラースキップ
　 Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)
　 On Error GoTo 0 'エラーが出たらストップ
　 '
　 If r1 Is Nothing Then
　　　MsgBox "空白なし", vbInformation
　 Else
　　　r1.Interior.ColorIndex = 5
　　　MsgBox "削除"
　　　r1.EntireRow.Delete '行全体を削除
　　　Set r1 = Nothing
　 End If
End Sub
【47788】Re:行の削除について
お礼  初心者 E-MAIL  - 07/3/22(木) 15:59 -
引用なし
パスワード
   ▼りん さん：
>▼初心者 さん：
>>A1からA700までの欄で空白なら、色をつけて行を削除したいのですが
>>色をつけるまでしかできませんでした。
>>行を削除するマクロを教えて頂けますでしょうか。
>>御忙しい所大変申し訳ございませんが、
>>宜しくお願い致します。
>
>削除をするなら色づけはいらないのでは？
>EntireRowで範囲を行全体に拡張します。
>
>Sub test()
>　 Dim r1 As Range
>　 On Error Resume Next　'エラースキップ
>　 Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)
>　 On Error GoTo 0 'エラーが出たらストップ
>　 '
>　 If r1 Is Nothing Then
>　　　MsgBox "空白なし", vbInformation
>　 Else
>　　　r1.Interior.ColorIndex = 5
>　　　MsgBox "削除"
>　　　r1.EntireRow.Delete '行全体を削除
>　　　Set r1 = Nothing
>　 End If
>End Sub

御忙しい所、大変ありがとうございます。
削除前に色をつけたのは、本当は色をつけなくても
よかったのですが、行の削除がわからなかった為に
自力で削除してた為間違わないように色をつけていました。

お早い対応ありがとうございました。
とても感謝しております。
【47814】Re:行の削除について
質問  tami  - 07/3/22(木) 22:17 -
引用なし
パスワード
   ▼りん さん：
今晩は。
横から失礼します。アドバイスお願いします。

りん さんの書かれたコードで
例えば
　　A
1
2
3
4　ddd
5　fff
6　kkk
7
8

このようなサンプルを実行すると、
色3がA1〜A3とA7〜A9に付きます。その後、Rowの１〜3が削除されますが
更に再度マクロを実行するとA4〜A9に色3が付きます
1　ddd
2　fff
3　kkk
4　色が付く
5　色が付く
:　色が付く
:

> Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)
このコードで正しいと思うのですが･･･
Set r1 = Range("A1:A" & Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)

に変えると、マクロを２度実行しても、色付けは発生しません。

Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)で、何故色付けが
残るのか
理由が分かりません、何故でしょうか？
【47815】Re:行の削除について
発言  ウッシ  - 07/3/22(木) 22:44 -
引用なし
パスワード
   こんばんは

> Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)
このコードでは「A1:A700」のうちUsedRngeが評価されます。

>色3がA1〜A3とA7〜A9に付きます。
9行目までがUsedRangeという事です。

>更に再度マクロを実行するとA4〜A9に色3が付きます
行を削除してもUsedRangeの情報は残っています。

>Set r1 = Range("A1:A" & Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
は実行する毎に最終データの有る行（一度目はA6、二度目はA3になってr1はNothing）

Sub test()
　 Dim r1 As Range
　 On Error Resume Next　'エラースキップ
　 Set r1 = Range("A1:A700").SpecialCells(xlCellTypeBlanks)
　 On Error GoTo 0 'エラーが出たらストップ
　 '
　 If r1 Is Nothing Then
　　　MsgBox "空白なし", vbInformation
　 Else
　　　r1.Interior.ColorIndex = 5
　　　MsgBox "削除"
　　　r1.EntireRow.Delete '行全体を削除
　　　Set r1 = Nothing
　　　ActiveSheet.UsedRange　'を入れるとUsedRangeが再評価される
　 End If
End Sub

とするといいと思います。

以上、全て結果から推測・・・・でした。
【47816】Re:行の削除について
お礼  tami  - 07/3/23(金) 7:16 -
引用なし
パスワード
   ▼ウッシ さん：

おはようございます。
よく理解できました。有難うございました。
UsedRangeが評価されるのですね。

UsedRangeの理解がいま少し出来ていないのですが･･･
最終行を抽出するときに、UsedRangeを使い、このような評価がされたような印象を残しています。

しかしSheets("sheet2").UsedRange.ClearContentsは完全に削除でき
便利なのですが・・・
時々、一行目(時には数行目まで）だけ残して、それ以外は全て削除にこの便利なUsedRangeが使えないか？など思う時があります(余談ですが）
【47834】Re:行の削除について
回答  りん E-MAIL  - 07/3/23(金) 12:56 -
引用なし
パスワード
   tami さん、こんにちわ。

>しかしSheets("sheet2").UsedRange.ClearContentsは完全に削除でき
>便利なのですが・・・
>時々、一行目(時には数行目まで）だけ残して、それ以外は全て削除にこの便利なUsedRangeが使えないか？など思う時があります(余談ですが）
InterSectメソッドで、削除していい部分とのかぶりを判定して、あったら削除します。
Sub test()
　 Dim Rmax　As Long
　 '
　 Rmax = 3 '残す行の一番下
　 With Application.ActiveSheet
　　　Set r1 = .Rows((Rmax + 1) & ":65536")
　　　Set r2 = .UsedRange
　 End With
　 '
　 Set r3 = Application.Intersect(r1, r2)
　
　 If Not r3 Is Nothing Then
　　　Set r3 = r3.EntireRow
　　　r3.Interior.ColorIndex = 5
　　　MsgBox "削除しますね"
　　　r3.Delete
　　　ActiveSheet.UsedRange'←これでちゃんと判定されるとは知りませんでした
　 Else
　　　MsgBox r2.Address, vbInformation, "UsedRange"
　 End If
End Sub

こんな感じです。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5989 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free