Excel VBA 将数据转移到下一个可用行

Question

我目前正在研究收入/支出监控 Excel。我有一个表来监视用户和其他人之间的待处理或未完成的事务。

我的电子表格中的实际表格是静态的，仅从 B52:H66 开始，无论那里输入了多少数据。

为简单起见，假设该表只有三列：NAME、AMOUNT 和 REMARKS。 REMARKS 列在列的每个单元格中有两个选项按钮：() 待处理和 () 已支付。这些按钮链接到它所在的单元格。点击 () Paid 将返回值“1”，而 () Pending 将返回值“2”。

我制作了一个宏按钮，单击该按钮将删除所有带有 () 付费备注的行。单击该按钮也会将选项按钮更改回 () Pending。但是，我还想在删除 () 付费数据后，将剩余的任何数据向上移动到表中的第一个可用单元格/行。

例如：（为简单起见，只说 4 个条目）

第 1 行：Ben --- $50 --- () 待处理

第 2 行：丹尼 --- 100 美元 --- () 已支付

第 3 行：Fay --- $280 --- () 已支付

第 4 行：黛安 --- 80 美元 --- () 待定

点击宏按钮--->删除所有（）付费条目--->结果如下

第 1 行：Ben --- $50 --- () 待处理

第 2 行：黛安 --- 80 美元 --- () 待定

从结果来看，Diane 从第 4 行转移到第 2 行，因为第 2 行和第 3 行现在是空白，第 2 行是下一个可用行。

我不知道如何实现这一点。我尝试进行研究，但似乎找不到合适的代码。一些网站建议删除该行并将单元格向上移动。但我不能这样做，因为该行中的其他数据也将被删除。我需要只删除输入数据而不是行本身。

请查看表格截图以供参考。

如果您遇到此问题，有什么建议或参考吗？非常感谢！

Sub OUTSTANDING()
If Response = vbNo Then Exit Sub
If Range("H52").Value = 1 Then
    Range("B52:G52").Select
    Selection.ClearContents
    Range("H52").Value = 2
End If
If Range("H53").Value = 1 Then
    Range("B53:G53").Select
    Selection.ClearContents
    Range("H53").Value = 2
End If
If Range("H54").Value = 1 Then
    Range("B54:G54").Select
    Selection.ClearContents
    Range("H54").Value = 2
End If
End Sub

此致，

弗里茨

Answer 1

假设单元格 B24:H24 具有底层单元格的标题，那么您可以使用 Autofilter 并避免循环

Sub test()
    With Range("B24:H66")
        .AutoFilter Field:=7, Criteria1:="1"
        With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
            If CBool(Application.Subtotal(103, .Cells)) Then .SpecialCells(xlCellTypeVisible).Delete xlShiftUp
        End With
        .Parent.AutoFilterMode = False
    End With
End Sub

Answer 2

使用数组

Sub test()
  Dim myRng As Range, i As Variant, j As Variant, n As Variant, ary As Variant

    Set myRng = Range("B25:H66")

    For i = 1 To myRng.Rows.Count
      If myRng.Cells(i, myRng.Columns.Count) <> 1 Then
        If Not IsArray(ary) Then
          ReDim ary(1 To myRng.Columns.Count, 1 To 1) As Variant
        Else
          ReDim Preserve ary(1 To UBound(ary, 1), 1 To UBound(ary, 2) + 1) As Variant
        End If

        For j = 1 To myRng.Columns.Count
          ary(j, UBound(ary, 2)) = myRng.Cells(i, j).Value
        Next j
      End If
    Next i

    If Not IsArray(ary) Then
        With myRng
            .Resize(, myRng.Columns.Count - 1).Value = ""
            .Resize(, 1).Offset(, .Columns.Count - 1).Value = 2
            Exit Sub
        End With
    Else
        If UBound(ary, 2) < myRng.Rows.Count Then
            n = UBound(ary, 2)
            ReDim Preserve ary(1 To UBound(ary, 1), 1 To myRng.Rows.Count) As Variant

            For j = n + 1 To myRng.Rows.Count
                ReDim Preserve ary(1 To UBound(ary, 1), 1 To j) As Variant

                For i = LBound(ary, 1) To UBound(ary, 1) - 1
                    ary(i, j) = ""
                Next i
                ary(UBound(ary, 1), j) = 2
            Next j
        End If
    End If

    myRng.Value = Application.Transpose(ary)
End Sub