历遍工作表筛选的问题

谢玉红

liulang0808 发表于 2023-3-3 10:28
第一行可以根据需求保留多个比对值

老师你好，谢谢了。各工作表返回的结果中，还差一个 序号  。如下图

ykcbf1100

谢玉红 发表于 2023-3-3 10:05
老师你好，非常感谢。试了一下，很快。但返回的结果不能放在Sheet0里。各工作表中，返回的结果，就保存在 ...

不过，这样的话，源数据就无法保留了。

liulang0808

谢玉红 发表于 2023-3-3 10:41
老师你好，谢谢了。各工作表返回的结果中，还差一个 序号  。如下图

序号对应的是什么啊 ？

谢玉红

liulang0808 发表于 2023-3-3 10:58
序号对应的是什么啊 ？

出自哪一行。

liulang0808

。。。。。。。。。。。。

谢玉红

liulang0808 发表于 2023-3-3 11:05
。。。。。。。。。。。。

谢谢老师。

lkqsmxw

ykcbf1100 发表于 2023-3-3 10:43
不过，这样的话，源数据就无法保留了。

KKKKKKKKKKKKKKKKKKKKK

ykcbf1100

lkqsmxw 发表于 2023-3-3 11:11
KKKKKKKKKKKKKKKKKKKKK

你这个不是楼主想要的结果，你这结果和我第一次差不多。

lkqsmxw

Sub ykcbf()    '//2023.3.3
    Dim arr, brr(1 To 60000, 1 To 10)
    Set sh = Sheets("Sheet0")
    With sh
        st1 = .[f1]
        st2 = .[h1]
    End With
    For Each SHt In Sheets
        If SHt.Name <> sh.Name Then
            arr = SHt.[a1:i50000]
            For i = 1 To UBound(arr)
                If arr(i, 6) = st1 And arr(i, 8) = st2 Then
                    m = m + 1
                    brr(m, 10) = SHt.Name & "表第" & i & "行"
                    For j = 1 To UBound(arr, 2)
                        brr(m, j) = arr(i, j)
                    Next
                End If
            Next
        End If
    Next
    With sh
        .[a15:z60000] = ""
        .[a15].Resize(m, 10) = brr
        For i = 1 To m
        ActiveSheet.Hyperlinks.Add anchor:=sh.Cells(i + 14, 10), Address:="", SubAddress:="'" & Split(brr(i, 10), "表")(0) & "'!a" & Replace(Split(brr(i, 10), "第")(UBound(Split(brr(i, 10), "第"))), "行", ""), TextToDisplay:=brr(i, 10)
        Next
    End With
End Sub