[[20200926105736]]　『空白セルの上詰めについて』（ゆり）　ページの最後に飛ぶ

『空白セルの上詰めについて』（ゆり）

空白のセル部分を行は削除せずに上に詰める方法を
ご教授お願いします。
空白は、式も何も入っていないただの空白です。
下記コードは検索で探しましたが、VBAはよくわからない為
宜しくお願いします。

現在使用の表構成です。
2配列でA～E と　F～J の配列です。
空白になるのは左(A～E)であればA～Eが空白になります。
右(F～J)であればF～Jが空白になります。

     A   B   C   D   E  |  F   G   H   I   J
                        |
 5   あ　い　う　え　お | さ　し　す　せ　そ
 6                      | た　ち　つ　て　と
 7   は　ひ　ふ　へ　ほ | 
 8                      | ま　み　む　め　も

下記のコードで上につまりますが、行は削除せず内容のみ上詰めにしたいです。

Sub Sample()

    Dim r As Range
    Dim d As Range
    With Range("A5", ActiveSheet.UsedRange).Columns("A:J")
        Set d = .Offset(.Rows.Count).Cells(1)
        For Each r In .Rows
            If WorksheetFunction.CountBlank(r) = r.Cells.Count Then Set d = Union(d, r.EntireRow)
        Next
    End With
    d.EntireRow.Delete
 End Sub

宜しくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

ジャンプ機能を使ってはどうでしょうか。
https://kokodane.com/tec3_27.htm#:~:text=%E3%82%B8%E3%83%A3%E3%83%B3%E3%83%97%E6%A9%9F%E8%83%BD%E3%82%92%E5%91%BC%E3%81%B3%E5%87%BA%E3%81%99%E3%81%AB,%E3%83%9C%E3%83%83%E3%82%AF%E3%82%B9%E3%82%92%E8%A1%A8%E7%A4%BA%E3%81%97%E3%81%BE%E3%81%99%E3%80%82&text=%EF%BC%885%EF%BC%89%5B%E7%A9%BA%E7%99%BD%E3%82%BB%E3%83%AB%EF%BC%BD,OK%EF%BC%BD%E3%82%92%E3%82%AF%E3%83%AA%E3%83%83%E3%82%AF%E3%81%97%E3%81%BE%E3%81%99%E3%80%82

（マナ） 2020/09/26(土) 11:27

 下の状態だったら、どうなればいいんですか？

      A   B   C   D   E  |  F   G   H   I   J
                         |
  5   あ　い　う　え　お | さ　  　す　せ　そ
  6                      | た　ち　つ　て　
  7   は　ひ　  　へ　ほ | 
  8           ふ         | ま　み　む　　　も

（半平太） 2020/09/26(土) 12:19

マナさま

ありがとうございます。
ジャンプ機能、調べてやってみます。

半平太さま

ありがとうございます。
A～E列もF～J列も横並びの5項目(5項目で1つ?と言う感じで)が全て入力されるか、されないかに
なります。
なので行で4項目になったりは無いので、横並びの5項目を上に詰めます。
空欄となるのは、必要でない部分を任意に削除しております。
（ゆり） 2020/09/26(土) 13:15

マクロの記録を実行してみました。

    Sub Macro5()
    '
    ' Macro5 Macro
    '

    '
        Range("A5:J12").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp
    End Sub

（マナ） 2020/09/27(日) 08:29

マナさま

ご教授ありがとうございます。
まずジャンプの空白セル削除を実際にやってみました。
なるほど。こんな機能があるとは・・
又、私もマクロの記録で実際に記録してみました。

結果としては、どちらも同じ結果ですが、ジャンプからの方は
若干、罫線が消える部分があるので、マクロの記録の方を使いたいと
思います。
ありがとうございました。
（ゆり） 2020/09/28(月) 08:45

 なんか、削除って言葉が気になるんで、削除しない方法で・・・
 文字を入れ替えているだけなので、罫線も残ったままです。
 ＞A～E列もF～J列も横並びの5項目(5項目で1つ?と言う感じで)が全て入力されるか、されないかに
    Sub test()
        Dim rw As Variant
        Dim i As Long
        Dim n As Long '------上詰めのカウント
        Dim tbl As Variant '-元データの格納
        Dim ans As Variant '-出力結果の格納
        '//A:E列の矩形範囲とF:J列の矩形範囲をForEachでループ
        For Each rw In Array(Range("E5", Cells(Rows.Count, "A").End(xlUp)), Range("J5", Cells(Rows.Count, "F").End(xlUp)))
            n = 1
            tbl = rw.Value
            ReDim ans(1 To UBound(tbl, 1), 1 To 5)
            For i = 1 To UBound(tbl)
                If tbl(i, 1) <> "" Then '----//もし、A列またはF列が空白なら、ansのn行にtblのi行を代入する
                    ans(n, 1) = tbl(i, 1)
                    ans(n, 2) = tbl(i, 2)
                    ans(n, 3) = tbl(i, 3)
                    ans(n, 4) = tbl(i, 4)
                    ans(n, 5) = tbl(i, 5)
                    n = n + 1
                End If
            Next i
            rw.Value = ans '-----------------//元の範囲に書き出し
        Next rw
        MsgBox "出力しました"
    End Sub

（稲葉） 2020/09/28(月) 09:47

稲葉さま

ご教授ありがとうございます。
早速実行した所、ちゃんと内容だけ
上に移動しました。
感謝です！本当に、ありがとうございました。
（ゆり） 2020/09/28(月) 20:42

コメント返信：

[ 一覧(最新更新順) ]

[[20200926105736]] 『空白セルの上詰めについて』（ゆり） ページの最後に飛ぶ

[[20200926105736]]　『空白セルの上詰めについて』（ゆり）　ページの最後に飛ぶ