Question

我正在尝试为我的一些员工提供一个简单的搜索选项卡，以便他们可以轻松地筛选特定条目的大型数据表，然后将主列表中的行复制到搜索选项卡中。

下面的代码实际上可以正常工作并复制匹配的条目中的数据，不幸的是＆＃34; country＆＃34;是唯一有效的标准，其余的标准无效。

我要做的是调整我编写的代码以使所有条件都有效，如果相应搜索中的条件为空，则忽略该条件允许复制和粘贴该单元格中的任何值。我正在考虑添加所有标准的If Else语句可以完成这项工作但是我不确定如何在VBA中为所有字符串正确添加If Else语句并告诉它如果它是空白则忽略标准。

＆＃13;

Sub search_and_extract_multicriteria()

Dim datasheet As Worksheet 'where is the data copied from
Dim reportsheet As Worksheet 'where is the data pasted to
Dim country As String
Dim SubType As String
Dim ProductName As String
Dim ProductFormula As String
Dim Source As String
Dim Rating As String
Dim finalrow As Integer
Dim i As Integer 'row counter

Set datasheet = Sheet1
Set reportsheet = Sheet3
country = reportsheet.Range("A3").Value
SubType = reportsheet.Range("C3").Value
ProductName = reportsheet.Range("D3").Value
ProductFormula = reportsheet.Range("E3").Value
Source = reportsheet.Range("F3").Value
Rating = reportsheet.Range("G3").Value

reportsheet.Range("A16:K500").ClearContents 

datasheet.Select
'finalrow = Cells(Row.Count, 1).End(x1Up).Row

For i = 2 To 500 'finalrow
    If Cells(i, 1) = country And Cells(i, 3) = SubType And Cells(i, 4) = ProductName And Cells(i, 5) = ProductFormula And Cells(i, 6) = Source And Cells(i, 2) = TestimonialType And Cells(i, 9) = Rating Then 
        Range(Cells(i, 1), Cells(i, 11)).Copy 'copy columns 1 to 11 (A to K)
        reportsheet.Select 
        Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats 
        datasheet.Select 
        End If
Next i

reportsheet.Select 'this is so that the report sheet is selected when the procedure ends

End Sub

＆＃13;

Answer 1

在检查变量是否填充了实际值之后，如何使用内置的AutoFilter方法而不是循环。

With datasheet.Range(.Range("A1"), .Cells(500, 11))

    If Len(country) Then .AutoFilter 1, country
    If Len(TestimonialType) Then .AutoFilter 2, TestimonialType
    If Len(SubType) Then .AutoFilter 3, SubType
    If Len(ProductName) Then .AutoFilter 4, ProductName
    If Len(ProductFormula) Then .AutoFilter 5, ProductFormula
    If Len(Source) Then .AutoFilter 6, Source
    If Len(Rating) Then .AutoFilter 9, Rating

    .Offset(1).SpecialCells(xlCellTypeVisible).Copy 'offset 1 to remove header row
    reportsheet.Range("A200").End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats

    .AutoFilter 'reset filter

End With

使用多个变量的VBA循环工作表过滤器

1 个答案: