質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

38940閲覧

VBA 空白行削除して上につめる その2

退会済みユーザー

退会済みユーザー

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

1クリップ

投稿2017/01/02 00:11

編集2017/01/02 06:40

お世話になっております。皆様にアドバイスを頂きながら、四苦八苦しながら
コードを書いております。空白行の削除&上に詰める処理で、どうしてもエラーが
でてしまい、朝から四苦八苦しております。

下記コードを実行すると、しっかりと、D列、E列は空白セルを削除し、
上に詰めることができました。以下の画像参照。
コード抜粋

vba

1'D列、E列の空白行を削除して上に詰める 2 3Dim D_MaxRow As Long 'D列に格納さている最大行数 4Dim Dell_Row As Long '削除する行 5 6D_MaxRow = Cells(Rows.Count, 4).End(xlUp).Row 7 8For Dell_Row = D_MaxRow To 3 Step -1 9 If Cells(Dell_Row, 4) = "" Then 10 11 Range(Cells(Dell_Row, 4), Cells(Dell_Row, 5)).Delete shift:=xlShiftUp 12 End If 13Next Dell_Row 14

イメージ説明

しかし、F列も空白セルを削除して上に詰めたいと思い、以下のコードを実行したところ、Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUpのコードで、

Rangeメソッドは失敗しました。'_Global'オブジェクトと出てエラーとなってしまいます。
ちなみに、デバックしてみた所、Dell_Rowには7が入っているので、ループの中を
1週はしている感じです。

コード抜粋

vba

1'F列の空白行を削除して上に詰める 2 3Dim F_MaxRow As Long 4F_MaxRow = D_MaxRow 5 6For Dell_Row = F_MaxRow To 3 Step -1 7 If Cells(Dell_Row, 6) = "" Then 8 Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp 9 End If 10Next Dell_Row

なぜ、エラーとなってしまうのでしょう??また、
D列、E列、F列の空白セルを一辺に削除し、上に詰める方法はないものでしょうか?

コード全体

vba

1 2'差分抽出マクロ 3 4Sub test1() 5Dim i As Long '作業前用カウンタ変数 6Dim j As Long '作業後用カウンタ変数 7Dim diff As Long '差分書き出し用変数 8Dim A_MaxRow As Long 9Dim D_MaxRow As Long 10Dim F_MaxRow As Long 11Dim Dell_Row As Long 12 13'作業前のMACを元に作業後のMACアドレスの比較を行う 14i = 3 15 Do While Cells(i, 1).Value <> "" 16 j = 3 17 Do While Cells(j, 4).Value <> "" 18 If Cells(i, 1) = Cells(j, 4) Then 19 Cells(i, 3).Value = "after_match" '作業後のMAC有り 20 End If 21 j = j + 1 22 Loop 23 i = i + 1 24 Loop 25 26'作業後のMACを元に作業前のMAアドレスんの比較を行う 27j = 3 28 Do While Cells(j, 4).Value <> "" 29 i = 3 30 Do While Cells(i, 1).Value <> "" 31 If Cells(j, 4) = Cells(i, 1) Then 32 Cells(j, 6).Value = "befor_match" 33 End If 34 i = i + 1 35 Loop 36 j = j + 1 37 Loop 38 39'xx_matchが無いものが差分なので別セルへ抜き出す 40'作業前でafter_matchが無いMACとホスト名を別セル(h列、i列)へ抜き出す 41diff = 3 42A_MaxRow = Cells(Rows.Count, 1).End(xlUp).Row 43 44 For i = 3 To A_MaxRow 45 If Cells(i, 3).Value <> "" Then 46 47 Else 48 Range(Cells(i, 1), Cells(i, 2)).Cut Destination:=Range(Cells(diff, 8), Cells(diff, 9)) 49 diff = diff + 1 50 End If 51 Next i 52 53 54'作業後でbefor_matchが無いMACとホスト名を別セル(j列、l列)へ抜き出す 55diff = 3 56D_MaxRow = Cells(Rows.Count, 4).End(xlUp).Row 57 58 For j = 3 To D_MaxRow 59 If Cells(j, 6).Value <> "" Then 60 61 Else 62 Range(Cells(j, 4), Cells(j, 5)).Cut Destination:=Range(Cells(diff, 10), Cells(diff, 11)) 63 diff = diff + 1 64 End If 65 Next j 66 67 68'D列、E列の空白行を削除して上に詰める 69 70For Dell_Row = D_MaxRow To 3 Step -1 71 If Cells(Dell_Row, 4) = "" Then 72 73 Range(Cells(Dell_Row, 4), Cells(Dell_Row, 5)).Delete shift:=xlShiftUp 74 End If 75Next Dell_Row 76 77'F列の空白行を削除して上に詰める 78 79F_MaxRow = D_MaxRow 80 81For Dell_Row = F_MaxRow To 3 Step -1 82 If Cells(Dell_Row, 6) = "" Then 83 Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp 'ここでエラーになる。 84 End If 85Next Dell_Row 86 87End Sub 88

どなたかご教授下さい。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

いっぺんに消すならば、
「処理したい範囲」を定義して
「その範囲の空欄のセルを消す」という流れでどうでしょうか。

Sub test2() Dim MyRng As Range Set MyRng = Range(処理したい範囲) '処理したい範囲を定義 MyRng.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp '範囲に含まれる空白セルを削除 End Sub

投稿2017/01/02 01:54

macinspire

総合スコア25

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

退会済みユーザー

退会済みユーザー

2017/01/02 06:14

処理したい範囲が固定なら、アドバイスいただいた方法でも良いと思いますが、 可変であるため、ちょっと違う方法の方がよいです。 Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUpのコードのエラーさえ解決できれば できるのですが・・・・。 本日、ず~と考えていますが、未だにエラーの原因がわかりません。。。。
macinspire

2017/01/02 07:00

rangeを使わず Cells(Dell_Row, 6).delete shift~ では、どうですか?
退会済みユーザー

退会済みユーザー

2017/01/02 08:52

確かに、Rngeを使わずに Cells(Dell_Row, 6).Delete shift:=xlShiftUpとしたらエラー無なく実行でき意図したとおりの処理が行われました。 しかし、 Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp 'エラーとなるコードと Cells(Dell_Row, 6).Delete shift:=xlShiftUpは一体何が違うのでしょう? 原因がさっぱり分かりません。。。
macinspire

2017/01/02 10:09

試しにもとのコードを Range(Cells(Dell_Row, 6),Cells(Dell_Row, 6)) とされると、おそらくエラーは出ないと思います。 rangeで、セル1つを書くのは文法ミスです。 (エクセルが、そのようにエラーメッセージを出してほしいものですが)
macinspire

2017/01/02 10:21

若干訂正します。 range()の中にはテーブル名を入れることができます。 range("変換表") range(cells(a,b))と書くと range(cells(a,b).value)と同義なので cells(a,b)の値をテーブル名とみなして参照するので「存在しない」と解釈されていると思われます。 ※推測を含みます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問