0

好的，解释这个问题有点困难，但我有一个 Excel 电子表格，可以过滤我在 Excel 中创建的数据库中的某些值，并将它们复制到各自的部分中。我有大约 10 个不同的部分，最后两个是 Adders & Take-Outs，对于某些系统大小，数据库中没有任何项目，所以如果我告诉它过滤 Adders，那么它会过滤并且数据库中没有行项目所以它会复制数据库中的每个项目（我不知道为什么）。下面是我的 Adders 部分的代码。

'To add Adders
Range("B12").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "ADDERS"
ActiveCell.Offset(1, 15).Select
ActiveCell.FormulaR1C1 = "ADDERS"
ActiveCell.Offset(-1, -15).Select
'To filter data
Sheets("Database").Select
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=5, Criteria1:="4600", Operator:=xlOr, Criteria2:="All"
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=6, Criteria1:="Adder"
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=7, Criteria1:=Array("6201", "6201 Elec", "6201 Eng", "6201 FS Rad", "6201 FS SW", "6201 Rad", "6201 SII", "6201 Train", "CH Elec", "CH Eng", "CH FS", "CH High", "CH SII", "CH Std", "CH SW", "CM", "CM Eng", "Coiler", "Elec", "Elec Eng", "Eng", "ES", "Fluids Eng", "FM", "FS Elec", "FS SII", "FS SW", "Launder", "MA", "MA FS", "MA SII", "MA Train", "ML", "PMDA", "PP High", "PP Low", "QS", "Selee", "Selee Eng", "SII", "STAS", "STAS FS", "Train"), Operator:=xlFilterValues
'To select correct data to copy
Application.Run ("SelectDataToCopy")
'To copy data
Sheets("Quote Sheet").Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.Run ("Borders")
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 14)).Select
Application.Run ("Borders")
'To insert formulas
Range("B12").Select
Cells.Find(What:="ADDERS", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(1, 1).Select
Application.Run ("Formulas")
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(""ADDERS"",C[-16]:C,17,FALSE)"
Application.Run ("AutofillOptions")

看到问题主要出在 Autofilter 部分。它过滤所有这些条件，但数据库中没有项目，因此它会复制所有内容。如果没有过滤项目，是否有代码或任何方法来更改此代码以告诉它退出此代码。我仍然希望它创建加法器部分，因为我有一个添加自定义项目的按钮，如果没有过滤，我只需要它不要复制所有项目。非常感谢任何帮助，谢谢。

4

1 回答 1

1 
Dim NoOfFilteredCells As Long
With ActiveSheet.ListObjects("Database").Range
    NoOfFilteredCells = .Count - .SpecialCells(xlCellTypeVisible).Count
End With

如果您只需要知道是否隐藏了任何内容，这将起作用。它所做的只是从细胞总数中减去可见细胞的数量，这将告诉您隐藏了多少。

然后你可以使用类似的东西

If NoOfFilteredCells > 0 Then
    'Put the code that does what you want it to do IF there ARE hidden rows here
Else: Exit Sub
End If

也许是这样的：

Sub Sample()
Dim NoOfFilteredCells As Long


With Range("B12").End(xlDown).Offset(1, 0)
    .Font.Bold = True
    .Font.Underline = xlUnderlineStyleSingle
    .FormulaR1C1 = "ADDERS"
    .Offset(1, 15).FormulaR1C1 = "ADDERS"
    .Offset(-1, -15).Select
End With
'To filter data
With ActiveSheet.ListObjects("Database").Range
    .AutoFilter Field:=5, Criteria1:="4600", Operator:=xlOr, Criteria2:="All"
    .AutoFilter Field:=6, Criteria1:="Adder"
    .AutoFilter Field:=7, Criteria1:=Array("6201", "6201 Elec", "6201 Eng", "6201 FS Rad", "6201 FS SW", "6201 Rad", "6201 SII", "6201 Train", "CH Elec", "CH Eng", "CH FS", "CH High", "CH SII", "CH Std", "CH SW", "CM", "CM Eng", "Coiler", "Elec", "Elec Eng", "Eng", "ES", "Fluids Eng", "FM", "FS Elec", "FS SII", "FS SW", "Launder", "MA", "MA FS", "MA SII", "MA Train", "ML", "PMDA", "PP High", "PP Low", "QS", "Selee", "Selee Eng", "SII", "STAS", "STAS FS", "Train"), Operator:=xlFilterValues
    NoOfFilteredCells = .Count - .SpecialCells(xlCellTypeVisible).Count
End With

If NoOfFilteredCells > 0 Then
    'To select correct data to copy
    Application.Run ("SelectDataToCopy")
    'To copy data
    Sheets("Quote Sheet").Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.Run ("Borders")
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 14)).Select
    Application.Run ("Borders")
    'To insert formulas
    Range("B12").Select
    Cells.Find(What:="ADDERS", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 1).Select
    Application.Run ("Formulas")
    ActiveCell.Offset(0, 2).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(""ADDERS"",C[-16]:C,17,FALSE)"
    Application.Run ("AutofillOptions")
Else: Exit Sub
End If

End Sub

但是，如果您实际上需要知道已过滤了多少行，则可以执行相同的过程，但将单元格数除以列数以返回行数。

Dim lngNoOfFilteredRows As Long
Dim lngNoOfColumns As Long

With ActiveSheet.ListObjects("Database").Range
    lngNoOfColumns = .Columns.Count
    lngNoOfFilteredRows = (.Count / lngNoOfColumns - 1) - (.SpecialCells(xlCellTypeVisible).Count / lngNoOfColumns - 1)
End With

代码中的负 1 用于说明标题。

于 2013-09-06T15:06:18.983 回答