批量比对列数据提取序号的问题

quqiyuan

大概这样，仅供参考了。。

quqiyuan

代码如下，，，，
Sub test()
    Application.ScreenUpdating = False
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets(1)
    arr = sht.[a1].CurrentRegion
    r = UBound(arr)
    s = arr(UBound(arr), 1)
    p = wb.Path & "\"
    f = Dir(p & "A*.xlsb")
    Do While f <> ""
        With Workbooks.Open(p & f, 0).Sheets(1)
            n = 0
            ReDim brr(1 To r, 1 To 2)
            arr = Intersect(.Range("1:" & r), .UsedRange)
            dixian = Application.Index(arr, UBound(arr))
            For i = 1 To UBound(dixian)
                If dixian(i) = s Then
                    For j = 1 To UBound(arr)
                        If arr(j, i) = s Then
                            n = n + 1
                            brr(n, 1) = j
                            brr(n, 2) = i
                        End If
                    Next
                End If
            Next
            .Parent.Sheets(2).[d1].Resize(n, 2) = brr
            .Parent.Close 1
        End With
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

杨小妹

非常感谢各位老师的帮助。没有分了，没给评分的，明天一定补上。

杨小妹

chxw68 发表于 2024-12-16 19:30
详见附件。

老师你好，非常感谢你的帮助。有个小小的问题，不知能否调整一下。即返回结果后，把工作薄中的Sheet2呈现在第一眼，即打开工作薄看到的是  Sheet2的内容？再谢。

chxw68

修改好了。