多条件查找表格筛选并部分复制到新地址

starlee0805

[求助]
数据库这样：



输入界面：


想要得到结果：

具体要求：

1，在筛选页面输入外径，壁厚，长度，材料及坡口角度五个尺寸；
2，筛选出输入长度和数据库长度相差在10以内，其他四个尺寸需一致的数据；
3，按照筛选出的数据长度由低到高的顺序排列，其中零件号，长度和描述三列复制到E1处；
4，出现长度与输入长度一致时，整行黄底底显示。

求助大神帮忙看看什么代码可以简单的实现，数据太大，搜索起来耗时间，用filter函数甚至还会发生错误。

starlee0805

当同时从两个工作表中表格抽取数据时，该咋弄？

linxing_1

starlee0805

linxing_1 发表于 2022-11-1 15:59

大神，材料这个条件怎么加进代码里的？
想把材料也作为搜索条件之一。

linxing_1

starlee0805 发表于 2022-11-1 16:23
大神，材料这个条件怎么加进代码里的？
想把材料也作为搜索条件之一。

没看懂，具体加到那个位置

starlee0805

linxing_1 发表于 2022-11-1 16:52
没看懂，具体加到那个位置

就是现在是材料这一栏没有作为搜索条件，希望能够输入材料时也能抽取到材料一直的数据。
同时还希望同时能从几个工作表抽取数据。

linxing_1

starlee0805 发表于 2022-11-1 17:16
就是现在是材料这一栏没有作为搜索条件，希望能够输入材料时也能抽取到材料一直的数据。
同时还希望同时 ...

外面再套一层循环即可



Sub dd()
    Dim sht As Worksheet
    Range("E2:G1000").Clear
    k = 2
   
    For Each sht In Worksheets
        If sht.Name <> "筛选页面" Then
            shtrows = sht.Cells(Rows.Count, 1).End(xlUp).Row
            For i = 3 To shtrows
                If sht.Cells(i, 4) - Cells(4, 3) < 10 And sht.Cells(i, 4) - Cells(4, 3) > -10 Then
                    If sht.Cells(i, 2) = Cells(2, 3) And sht.Cells(i, 3) = Cells(3, 3) And sht.Cells(i, 6) = Cells(6, 3) Then
                       Cells(k, 5) = sht.Cells(i, 1)
                       Cells(k, 6) = sht.Cells(i, 8)
                       Cells(k, 7) = sht.Cells(i, 4)
                       k = k + 1
                    End If
                End If
            Next
        End If
    Next
    For j = 2 To Cells(Rows.Count, 7).End(xlUp).Row
        If Cells(j, 7) = Cells(4, 3) Then
            Range(Cells(j, 5), Cells(j, 7)).Interior.Color = VBA.vbYellow
        End If
    Next
End Sub

zlzz1971

只有WPS能用