[[20210729180515]]　『空白行のオフセットについて』（ちいきも）　ページの最後に飛ぶ

『空白行のオフセットについて』（ちいきも）

こんにちは。

行に入力させているデータが空白になった時に、
下の行に入力されているデータを上に
詰める方法についての質問です。

下のマクロで、A~Cの行が空白になった場合
行を上にオフセットするが出来たのですが、Deleteで
セルごと消されてオフセットされてしまうので、
セル内のデータのみオフセットするように改良できませんでしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rs As Range
Dim dt As Range

With Range("A1", ActiveSheet.UsedRange).Columns("A:C")
Set t = .Offset(.Rows.Count).Rows(1)
For Each s In .Rows
If WorksheetFunction.CountBlank(s) = s.Cells.Count Then Set t = Union(t, s)
Next
End With
t.Delete xlUp

End Sub

よろしくお願いいたします。

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

作業列を使って並べ替えるとか。

（マナ） 2021/07/29(木) 19:01

 下から順にコピぺして、下の余分をクリア(ちょい無駄気味)。
 という建付けで考えてみました。

    Sub test()
        Dim r As Long, flgBlank As Boolean
        Dim sR As Range
        With Range("A1", ActiveSheet.UsedRange).Columns("A:C")
            For r = .Rows.Count To 1 Step -1
                If WorksheetFunction.CountA(.Rows(r)) > 0 Then
                    If flgBlank And Not sR Is Nothing Then
                        sR.Copy .Rows(r + 1)
                        Range(.Rows(r + 1 + sR.Rows.Count), .Rows(.Rows.Count)).Clear
                    End If
                    Set sR = Range(.Rows(r), .Rows(.Rows.Count))
                    flgBlank = False
                Else
                    flgBlank = True
                End If
            Next
        End With
    End Sub

（白茶） 2021/07/29(木) 19:45

 ちょっとアイディア倒れかも
 Sub sample()
   Const fstr As String = "=FILTER(A1:C#,(A1:A#<>"""")*(B1:B#<>"""")*(C1:C#<>""""))"
   With ActiveSheet
      With .Range("A1", .UsedRange).Columns("A:C")
         nr = .Rows.Count
         buf = Evaluate(Replace(fstr, "#", nr))
         .ClearContents
         .Cells(1, 1).Resize(UBound(buf), 3).Value = buf
      End With
   End With
 End Sub
（´・ω・`） 2021/07/29(木) 20:48

 こんばんは！
現状のコードを尊重して、、値だけで良ければ。。。。

 Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant
Dim x As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim MyFlg As Boolean
With Range("A1", Me.UsedRange).Columns("A:C")
    v = .Value
    ReDim x(LBound(v, 1) To UBound(v, 1), LBound(v, 2) To UBound(v, 2))
    For i = LBound(v, 1) To UBound(v, 1)
        MyFlg = False
        For j = LBound(v, 2) To UBound(v, 2)
            If v(i, j) <> Empty Then
                MyFlg = True
                Exit For
            End If
        Next
        If MyFlg Then
            k = k + 1
            For j = LBound(v, 2) To UBound(v, 2)
                x(k, j) = v(i, j)
            Next
        End If
    Next
    Application.EnableEvents = False
        .Value = x
    Application.EnableEvents = True
End With
Erase v, x
End Sub
（SoulMan） 2021/07/29(木) 21:08

 私のはダメでした。ちょっとテスト不足
 Filterの条件は * じゃなくて + じゃないとダメですね。
（´・ω・`） 2021/07/29(木) 21:48

 あ、ちなみに私のは

 Deleteでオフセットされてしまうのがイヤって事は、
 [A:C]の各行を参照している計算式が他の列にあるのではないか?

                    ...と予想してコピペ方式にしてみたんですよね。
                       なので、違う事情ならあんまり良くないかも知れません。

（白茶） 2021/07/29(木) 21:58

コメント返信：

[ 一覧(最新更新順) ]

[[20210729180515]] 『空白行のオフセットについて』（ちいきも） ページの最後に飛ぶ

[[20210729180515]]　『空白行のオフセットについて』（ちいきも）　ページの最後に飛ぶ