使用vba創建復雜的宏

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