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

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

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

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

解決済

【VBA】行間を詰めるマクロが組みたい(結合セルあり)

METEORS
METEORS

総合スコア1

VBA

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

1回答

0グッド

0クリップ

302閲覧

投稿2022/12/01 13:19

編集2022/12/01 14:48

前提

excel 2019にて、行間を削除する軽量なマクロが組みたいです。
自分が組んだ結果、無駄に処理が重く軽量化したいです。

質問内容、文法等不明瞭な点あるかと思いますが何卒ご指導お願い致します。

実現したいこと

以下の添付画像のように、AB列を変更せずに行間を詰め、
最後にAD列に「円」を入れたいです。
AB列の数字は1~30まで(20列目~49列目まで)あります。

※22.12.01. 23:45追記 見切れてい為、画像3枚目追加します。大変失礼いたしました。
下部のレイアウトが崩れないようにしたいです。

イメージ説明

イメージ説明

イメージ説明

VBA ソースコード Sub 行削除() Application.ScreenUpdating = False Dim RowCnt As Integer For RowCnt = 1 To 30 Dim i As Long For i = 20 To 48 If Cells(i, 3) = "" Then Range(Cells(i, 3), Cells(i, 30)) = "" Range(Cells(i + 1, 3), Cells(i + 1, 33)).Copy Range(Cells(i, 3), Cells(i, 30)).PasteSpecial xlPasteAllExceptBorders Range(Cells(i + 1, 3), Cells(i + 1, 33)) = "" End If Next i Next Range("AC20:AC49") = "円" End Sub

試したこと

Range("").End(xlDown)でデータ取得し横へ選択しコピー等検討しましたが
取得した点から横軸のセルを選択しコピーする処理が書けませんでした。
ご指導お願いいたします。

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

ここにより詳細な情報を記載してください。

以下のような質問にはグッドを送りましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

グッドが多くついた質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

下記のような質問は推奨されていません。

  • 間違っている
  • 質問になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

適切な質問に修正を依頼しましょう。

hatena19

2022/12/01 13:47

A列とB列, C~F列, ・・・・AD~AG列は、セル結合しているのでしょうか。 > AD列に「円」を入れたいです。 AH列にすでに「円」が入ってますが、AD~AG列の数値の後に円を付けたいということでしょうか。
METEORS

2022/12/01 14:15

コメントありがとうございます。補足させていただきます。 ①A~B、C~F、G~L、M~T、U~W、Y~AB、AD~AG列がそれぞれ結合されております。 (帳票ソフトの関係上です) ②AC列、AH列に元々「円」が入っております。  行を詰めた後、空白となった下の方の行のAC列、AH列に「円」が残る形にしたいです。 何卒宜しくお願い致します。  

回答1

2

ベストアンサー

C20から最終行(画像なら27)までの範囲でC列が空白のC~AH列までの行を削除して上に詰める処理でどうでしょう。
下記のようなコードで可能です。

vba

1Public Sub Sample() 2 Dim rng As Range, r As Range, delr As Range 3 Set rng = Range("C20:AH" & Cells(50, "C").End(xlUp).Row) 4 5 For Each r In rng.Rows 6 If r.Cells(1).Value = "" Then 7 If delr Is Nothing Then 8 Set delr = r 9 Else 10 Set delr = Union(delr, r) 11 End If 12 End If 13 Next 14 delr.Delete Shift:=xlUp 15End Sub

投稿2022/12/01 14:10

hatena19

総合スコア32005

spoofy_dragon, METEORS👍を押しています

良いと思った回答にはグッドを送りましょう。
グッドが多くついた回答ほどページの上位に表示されるので、他の人が素晴らしい回答を見つけやすくなります。

下記のような回答は推奨されていません。

  • 間違っている回答
  • 質問の回答になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

このような回答には修正を依頼しましょう。

回答へのコメント

METEORS

2022/12/01 14:27

ご回答いただき本当にありがとうございます。 試しに動作させてみたところかなり動作早く感激しております。 頂きましたコード、参考にさせて頂きます。

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

ただいまの回答率
86.12%

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

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

質問する

関連した質問

同じタグがついた質問を見る

VBA

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

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。