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

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

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

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

Q&A

解決済

2回答

10657閲覧

空白行を削除せずに詰める方法を教えてください。

matuo7538

総合スコア11

VB

VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

0グッド

0クリップ

投稿2021/02/19 14:54

編集2021/02/20 01:47

前提・実現したいこと

別のブックからシートをコピーし、貼り付けをした後に、L列にある空白のセル以外を削除してから、さらに空白を詰めたいのですが、ご教授いただければ幸いです。

発生している問題・エラーメッセージ

L列にある空白のセル以外を削除してみたら、空白のセルも消えてしまう。
空白を詰めてみたら、文字が下に下に上書きされてしまう。

エラーメッセージ

該当のソースコード

Dim

1Dim sh As Worksheet 2Dim rE As Long 3Dim i As Long 4Dim toprow As Long 5Dim bottomrow As Long 6Dim k As Integer 7Dim j As Integer 8 9Sub main() 10 11tyusyutu 12CommandButton1_Click 13Tumeru 14End Sub 15 16Sub tyusyutu() 17 18'データのコピー 19 Set wb = Workbooks.Open("C:\Book1.xlsx") 20 Set sh = wb.Sheets(2) 21 rE = sh.Cells(Rows.Count, "B").End(xlUp).Row 22 Range(Cells(5, "B"), Cells(rE, "L")).Copy 23 wb.Close 24 Cells(5, "B").PasteSpecial 25End Sub 26 27Private Sub CommandButton1_Click() 28''''''''''''''''''''''''''''''''''''''''''''''''''' 29 '開始する行 30 toprow = 5 31 '終了する行 32 bottomrow = 74 33 34 For i = bottomrow To toprow Step -1 35 If ActiveSheet.Cells(i, 12) <> "" Then 36 Range("B5:L74").Rows(i).ClearContents 37 End If 38 Next 39''''''''''''''''''''''''''''''''''''''''''''''''''' 40End Sub 41 42Sub Tumeru() 43''''''''''''''''''''''''''''''''''''''''''''''''''' 44j = 5 45For k = 5 To Range("B" & Rows.Count).End(xlUp).Row 46If (Range("B" & k).Rows <> "") Then 47j = j + 1 48Range("B" & k).Resize(, 11).Copy Range("B" & j) 49Range("B" & k).Resize(, 11) = "" 50End If 51Next k 52''''''''''''''''''''''''''''''''''''''''''''''''''' 53End Sub 54 55コード

試したこと

ここに問題に対して試したことを記載してください。

補足情報(FW/ツールのバージョンなど)

ほかのbookから貼り付けます。
ほかのbookから貼り付けます。
L列の文字が入っているセルを削除しようとします。
L列の文字が入っているセルを削除しようとします。
真っ白になる。
真っ白になる。
下にスクロースすると、一番上の貼り付けたセルが、一番下に降りてしまう。
下にスクロースすると、一番上の貼り付けたセルが、一番下に降りてしまう。

と、こんな感じになってしまいます。
わかりにくいかもしれませんが、よろしくお願いします。

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

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

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

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

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

radames1000

2021/02/19 23:09

コードが見づらいので```でコードを囲んでください。 また、具体例(今の表⇒こんな形にしたい)をそれぞれ画像等であげてください。
meg_

2021/02/20 00:28

コードは「コードの挿入」で記入してください。
matuo7538

2021/02/20 01:59

修正しましたので、よろしくお願いします。
guest

回答2

0

ベストアンサー

とりあえず、
Range("B5:L74").Rows(i).ClearContents のところは、
ActiveSheet.Rows(i).ClearContents ではないかと思います。

投稿2021/02/20 01:38

jinoji

総合スコア4585

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

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

matuo7538

2021/02/20 01:57

ご回答ありがとうございます。 ActiveSheetに変えると、行ごとクリアされてしまいました。 そもそもrowsを使うこと自体間違いなのでしょうか?
jinoji

2021/02/20 02:00

あ、失礼しました。 ActiveSheet.Columns("B:L").Rows(i).ClearContents ならどうでしょう。
jinoji

2021/02/20 02:02

Range("B5:L74").Rows(i) だと、iが5の時は9行目("B5:L74"の中の5行目)が処理されるはず。
jinoji

2021/02/20 02:04

そもそも、こんな感じではいけないのでしょうか。 Dim O As Worksheet, P As Worksheet Set O = Sheets("O") Set P = Sheets("P") Dim i, j j = 5 For i = 5 To P.Cells(Rows.Count, "B").End(xlUp).Row If P.Cells(i, "L") = "" Then P.Cells(i, "B").Resize(, 11).Copy O.Cells(j, "B") j = j + 1 End If Next
matuo7538

2021/02/20 13:34

ありがとうございます。 教えていただいたおかげで、文字の入ったものを消すことができました。 あと、ややこしくしてしまい申し訳ございません。 Oのシート、質問とまったく関係ありません。 もし、私が的外れなことを言っていたら、申し訳ございません。
jinoji

2021/02/20 13:56 編集

こちらこそ失礼しました。別のブックから、と書いてあるのを見落としていました。 ただ、言いたかったのは、コピーしてからクリアして詰める、じゃなくて、 最初から必要な行を選びながらコピーする手もあるのでは、ということです。 Sub tyusyutuAndTumeru() 'データのコピー Set outSheet = Activesheet Set wb = Workbooks.Open("C:\Book1.xlsx") Set sh = wb.Sheets(2) rE = sh.Cells(Rows.Count, "B").End(xlUp).Row Dim i, j j = 5 For i = 5 To rE If sh.Cells(i, "L") = "" Then sh.Cells(i, "B").Resize(, 11).Copy outSheet.Cells(j, "B") j = j + 1 End If Next wb.Close End Sub
matuo7538

2021/02/21 09:08 編集

思った通りにできました! ありがとうございました。
guest

0

おそらく一番の原因はTumeruの方ですね。

現在のコードを実行すると、

・5行目→6行目にコピーし、5行目を削除
・6行目→7行目にコピーし、6行目を削除

といった具合に繰り返されてしまい、結果として途中のデータはすべて消去され、最終行に5行目のデータが残るのみ、という挙動をしています。
このあたりの不具合は、F8によるステップ実行などを使えるようになると、容易に発見できるようになると思います。

肝心の解決策については色々なやり方がありますが、まずは素直に逆順ループをして、空白行を削除していくのが良いと思います。

VBA

1Sub Tumeru() 2 3For k = Range("B" & Rows.Count).End(xlUp).Row To 5 Step -1 4 If (Range("B" & k) = "") Then 5 6 Range("B:L").Rows(k).Delete Shift:=xlUp 7 8 End If 9Next k 10 11End Sub

【追記】
上記のコードは単純ですが、件数が多い場合はとんでもなく遅くなります。
そうした遅さに耐えられなくなった場合は、例えば以下のようにDelete処理を一回にまとめるとはやいです。

VBA

1Sub Tumeru() 2 3Dim Target As Range 4For k = 5 To Range("B" & Rows.Count).End(xlUp).Row 5 If (Range("B" & k) = "") Then 6 7 If Target Is Nothing Then 8 9 Set Target = Range("B:L").Rows(k) 10 11 Else 12 13 Set Target = Union(Target, Range("B:L").Rows(k)) 14 15 End If 16 17 End If 18Next k 19 20Target.Delete shift:=xlUp 21 22End Sub

投稿2021/02/20 02:35

編集2021/02/20 07:53
Usirow

総合スコア364

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

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

matuo7538

2021/02/20 13:28

ありがとうございます。 書式を消さずに空白を詰めたいので、教えていただいたコードのDeleteを、ClearContentsに変えればできるかと思って実行したところ、「アプリケーション定義またはオブジェクト定義エラーです」と出てしまいました。 説明が足りなく申し訳ございません。 よろしければ、ご教授願います。
Usirow

2021/02/22 02:35

私の書いたコードの場合「空白行をDeleteして、削除された分を上方向に詰める」というつくりなので、そもそもClearContentsしても何も起きないと思います。 そしてClearContentsでそのエラーが出るのは、申し訳ないですがよくわかりません。考えられることは「shift:= xlUp」をそのままにしてしまっている、くらいでしょうか。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.44%

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

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

質問する

関連した質問