Question

我有一个复杂的工作簿，需要使用vba进行过滤。

我需要删除G列中包含空白单元格的行。
然后我需要隐藏C到G列。
然后我需要对H列进行过滤以删除所有大于2的行。
最后，我需要从最大到最小排序的列。

这是我到目前为止所拥有的，但是它成功了一半，并且我不想使用命令按钮。我希望能够在此处粘贴文档，并且代码会自动对其起作用。

Private Sub CommandButton1_Click()
'Created by William Hinebrick 277096
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Please select range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Areas.Count > 1) Or (xRg.Columns.Count > 1) Then
        MsgBox "You can only select one column per time", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    xRg.Range("A1").EntireRow.Insert
    Set xRg = xRg.Range("A1").Offset(-1).Resize(xRg.Rows.Count + 1)
    xRg.Range("A1") = "Temp"
    xRg.AutoFilter 1, ">2"
    Set xRg = Application.Intersect(xRg, xRg.SpecialCells(xlCellTypeVisible))
    On Error GoTo 0
    If Not xRg Is Nothing Then xRg.EntireRow.Delete
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Created by William Hinebrick 277096
    Dim xRg As Range
    Application.ScreenUpdating = False
        For Each xRg In Range("G1:G10000")
            If xRg.Value = "" Then
                xRg.EntireRow.Hidden = True
            Else
                xRg.EntireRow.Hidden = False
                End If
        Next xRg
    Application.ScreenUpdating = True
End Sub

Sub Column_Hide()
'Created by William Hinebrick 277096
    Columns("C:G").EntireColumn.Hidden = True
    Columns("J").EntireColumn.Hidden = True

End Sub

Private Sub Sort_Drop(ByVal Target As Range)
    On Error Resume Next
    Range("I1").Sort Key1:=Range("I2"), _
      Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
End Sub

我希望每天都可以使用此功能，因为我会将新的电子表格粘贴到要过滤的工作表中，以便使结果简洁明了

Answer 1

这应该执行列出的所有操作。

如果您要求它在每次复制数据时都执行，那么第二个子项目中的Worksheet_Change事件就是解决之道。但这意味着它还会在您更改工作簿中的其他内容时运行。我个人只是为其分配了键盘快捷键。似乎是最简单的方法。

Option Explicit
Sub test()

Dim i As Double
Dim lastrow As Double

  lastrow = ActiveSheet.UsedRange.Rows.Count

  For i = lastrow To 2 Step (-1) 'delete empty G cells
    If ActiveSheet.Cells(i, 7).Value = "" Then Cells(i, 7).EntireRow.Delete
  Next

  lastrow = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row

  For i = lastrow To 2 Step (-1) 'delete H >2
    If ActiveSheet.Cells(i, 8).Value > 2 Then Cells(i, 8).EntireRow.Delete
  Next

Columns("C:G").EntireColumn.Hidden = True 'hide columns

Range("I1").Sort Key1:=Range("I2"), _
      Order1:=xlDescending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom 'Sort by I descending order

End Sub

使用VBA创建复杂的宏

1 个答案: