создание сложного макроса с использованием vba

Question

У меня сложная рабочая книга, которую мне нужно отфильтровать с помощью vba.

• Мне нужно удалить строки с пустыми ячейками из столбца G.
• Затем мне нужно скрыть столбцы с C по G.
• Затем мне нужно отфильтровать столбец H, чтобы удалить все строки больше 2.
• Наконец мне нужен столбец I, отсортированный от наибольшего к наименьшему.

Это то, что у меня есть, но оно работает наполовину, и я не хочу использовать командную кнопку.Я хочу иметь возможность вставить документ сюда, и код автоматически сработает.

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 из вашего 2-го подпункта - путь. Но это означает, что он также запускается каждый раз, когда вы что-то меняете в своей книге. Я бы лично назначил ему сочетание клавиш. Кажется, самый простой путь.

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