用新插入的行更新excel自动筛选器为可见

bakd9h0s  于 2023-03-13  发布在  其他
关注(0)|答案(1)|浏览(130)

我有一个宏,它可以通过输入在命名区域中插入新行。它按字母顺序插入。我的问题是,当该行可见时,自动筛选不会将新行更新为可见。如何使用VBA将新行更新为可见?
下面是添加新行的代码。

Dim sNewName As String
Dim lPosition As Long
Dim rCompList As Range

Set rCompList = Sheets("Sheet4").Range("Companies2")

sNewName = InputBox("Enter name of new company")
On Error Resume Next
lPosition = Application.WorksheetFunction.Match(sNewName, rCompList, 2)
On Error GoTo 0
Rows(lPosition + 2).Insert
Range("A" & lPosition + 2).Value = sNewName

这是一个录制的宏,使一个公司可见的自动筛选。我添加了“Rotork”

ActiveSheet.Range("$A$2:$A$160").AutoFilter Field:=1, Criteria1:=Array( _
        "ABS", "Accurate", "AGI", "Alexander Ryan Marine", "Alimak", "Audubon", _
        "Relevant", "Rig Net", "Rotork", "Seatrax", "Solar", "Tampnet", "Third Coast", _
        "Total Daily POB", "Trinity", "USCG"), Operator:=xlFilterValues

需要说明的是:由于可见公司的数组会不时地发生变化,我需要找到一种方法,将可见公司的数组存储为变量,然后将新公司添加到该数组中,或者使用其他方法来实现相同的目标
我曾试图找到其他相关的答案,但没有匹配或工作。

hc8w905p

hc8w905p1#

使用Transpose从可以在筛选器中使用的范围创建一个数组,

Option Explicit

Sub demo()

    Dim rCompList As Range
    Dim sNewName As String, lastrow As Long
   
    sNewName = Trim(InputBox("Enter name of new company"))
    If Len(sNewName) = 0 Then
        MsgBox sNewName & "Blank entry", vbExclamation
        Exit Sub
    End If
    
     ' check not existing
    Set rCompList = Sheets("Sheet4").Range("Companies2")
    If WorksheetFunction.CountIf(rCompList, sNewName) > 0 Then
        MsgBox sNewName & " exists already", vbExclamation
        Exit Sub
    End If
    
    ' insert at top assume row 1 is header
    rCompList.Rows(2).Insert Shift:=xlDown
    rCompList.Cells(2, 1) = sNewName
    ' sort list
    With rCompList.Parent.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=rCompList.Cells(1), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rCompList
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' update filter
    With Sheets("Sheet1") ' or ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A2:A" & lastrow).AutoFilter Field:=1, _
         Criteria1:=Application.Transpose(rCompList), _
         Operator:=xlFilterValues
    End With
         
End Sub

相关问题