Excel VBA – 自动筛选的行数总是返回1

我目前使用自动filter来筛选两列。 如果自动筛选的结果仅对可见单元格为空,则会添加一个新行。 如果find除标题以外的任何行,则将显示一个MsgBox。 问题是行数总是返回1.我试过重新定义“rng”几个方法无济于事。

Dim ws As Worksheet Dim rng As Range Set ws = Sheets("Scored Items") Worksheets("Scored Items").Activate ws.AutoFilterMode = False With ws .Range("A:D").AutoFilter Field:=1, Criteria1:=AssetBox.Text .Range("A:D").AutoFilter Field:=4, Criteria1:=PartBox.Text Set rng = .Range("A:A").SpecialCells(xlCellTypeVisible) If (rng.Rows.Count = 1) Then 'Add new row based on VBA form Else MsgBox "Item has already been scored" End If End With ws.Cells.AutoFilter 

而不是检查Rows.Count,检查Cells.Count可见的行。 试试像这样…

 Dim ws As Worksheet Dim rng As Range Dim lr As Long Set ws = Sheets("Scored Items") lr = ws.UsedRange.Rows.Count Worksheets("Scored Items").Activate ws.AutoFilterMode = False With ws .Range("A1:D" & lr).AutoFilter Field:=1, Criteria1:=AssetBox.Text .Range("A1:D" & lr).AutoFilter Field:=4, Criteria1:=PartBox.Text Set rng = .Range("A1:A" & lr).SpecialCells(xlCellTypeVisible) If rng.Cells.Count = 1 Then 'Add new row based on VBA form Else MsgBox "Item has already been scored" End If End With ws.AutoFilterMode = False 

如果范围对象是非连续的, .Rows.Count将仅返回范围的第一个Area中的行数,在这种情况下,这将是“标题”行。 (注意:如果你的filter是第一行数据是可见的,但是第二行没有,你会得到2结果)。

处理已过滤的范围时,需要迭代Areas中的区域。

  Dim aRange as Range For Each aRange in rng.Areas If (aRange.Rows.Count = 1) Then 'Add new row based on VBA form Else MsgBox "Item has already been scored" End If Next 

在这种情况下,如果Areas.Count > 2以及任何aRange.Rows.Count <> 1等,您可能想标记一些错误

如果你只是使用AutoFilter来检查这个范围内是否存在一个值(也就是说,为了防止在表中重复input?),这是一个相当笨拙的方法来做到这一点,你可能会更好地使用COUNTIF函数。

 If Application.WorksheetFunction.CountIf(.Range("A:A"),AssetBox.Text) = 1 And _ Application.WorksheetFunction.CountIf(.Range("D:D"), PartBox.Text) = 1 Then 'Add new row based on VBA Form Else MsgBox "Item has already been scored" End If 

从你的评论后续,因为这是一个用户界面,我会同时使用。 显然,你希望AutoFilter向用户显示数据,所以保持这一点。 但不是试图绕过过滤数据的各个Areas ,只需使用COUNTIF函数来检查

 'Filter data to display to the user Dim dataRange As Range Set dataRange = ws.Range("A:D") With dataRange .AutoFilter Field:=1, Criteria1:=AssetBox.Text .AutoFilter Field:=4, Criteria1:=PartBox.Text 'Check if part already been scored With Application.WorksheetFunction If .CountIf(.Columns(1), AssetBox.Text) = 1 And _ .CountIf(.Columns(4), PartBox.Text) = 1 Then 'Add new row based on VBA Form Else MsgBox "Item has already been scored" End If End With 'unfilter the data ws.Cells.AutoFilter