编号查工资

吴中泉

可参考这个帖子

https://club.excelhome.net/thread-1662654-2-1.html

cyq4896

试试这个可以吗

cyq4896

Sub 查找工资()
    Dim i&, j&, n%, l%, sht As Worksheet, k%, arr, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    brr = Range("b1:g1")
     Sheet1.UsedRange.Offset(1).Clear
    n = 1
    bh = Sheet1.Cells(1, 1)
    For Each sht In Worksheets
        If sht.Name <> "姓名查工资" Then
            arr = sht.Range("a1").CurrentRegion
           For l = 1 To UBound(arr, 2)
                dic(arr(1, l)) = l
            Next
            For j = 1 To UBound(arr, 2) Step 6
                For i = 2 To UBound(arr)
                    If arr(i, j + 1) = bh Then
                       n = n + 1
                        Cells(n, 2) = sht.Name
                        Cells(n, 3) = arr(1, dic(arr(1, j)))
                        For k = 1 To 4
                                Cells(n, k + 3) = arr(i, j + k + 1)
                        Next
                    End If
                Next
            Next
        End If
        Sheet1.Range("b2:g" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row).Borders.LineStyle = 1
    Next
   
End Sub

于箱长

zxsea_7426 发表于 2023-5-17 00:03
代码调试一遍又一遍，
发现数据格式有点乱啊。
一、2014多增加一个A列

         

于箱长

cyq4896 发表于 2023-5-17 11:11
试试这个可以吗

再试一下，把查询结果放入数组，再看看速度