使用数组

Question

我目前正在从事收入/支出监控Excel。我有一个表，用于监视用户与其他人之间的挂起或未完成的事务。

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

为简单起见，假设该表只有三列：NAME，AMOUNT和REMARKS。 “备注”列在该列的每个单元格中具有两个选项按钮：（）待处理和（）付费。这些按钮链接到其所在的单元格。点击（）付费将返回值“ 1”，而（）待处理将返回值“ 2”。

我做了一个宏按钮，单击该按钮将删除带有（）付费备注的所有行。单击按钮还将选项按钮改回（）待处理。但是，我还希望在删除（）付费数据后，将剩下的所有数据向上移动到表中的第一个可用单元格/行。

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

ROW 1：本--$ 50 ---（）待处理

ROW 2：Danny --- $ 100 ---（）Paid

ROW 3：Fay --- $ 280 ---（）Paid

第4行：黛安--- $ 80 ---（）待审核

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

ROW 1：本--$ 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

此致

Fritze

Answer 1

使用数组

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

Answer 2

假设单元格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

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

2 个答案:

使用数组