Sub aaa()
    Dim arr, brr(), d As Object, sht As Worksheet
    Dim m As Long, n As Long, i As Long, j As Integer, lr As Long, lc As Integer
    Set d = CreateObject("scripting.dictionary")
    d("序号") = 1: d("姓名") = 2
    m = 2
    For Each sht In Sheets
        With sht
            If .Name <> "汇总表" Then
                arr = .UsedRange
                For i = 3 To UBound(arr, 2)
                    temp = arr(2, i)
                    If temp <> "" And temp <> "日工时合计" Then
                        If d(temp) = "" Then
                            m = m + 1
                            d(temp) = m
                        End If
                    End If
                Next
            End If
        End With
    Next
    For Each sht In Sheets
        With sht
            If .Name <> "汇总表" Then
                arr = .UsedRange
                lr = UBound(arr)
                lc = UBound(arr, 2)
                If lr > 2 Then '有数值
                    For i = 3 To lr
                    n = n + 1
                    ReDim Preserve brr(1 To m, 1 To n)
                    brr(2, n) = .Name
                    brr(1, n) = arr(i, 1)
                        For j = 1 To lc
                            If d(arr(2, j)) <> "" Then brr(d(arr(2, j)), n) = arr(i, j)
                        Next j
                    Next i
                End If
            End If
        End With
    Next
    ActiveSheet.UsedRange.Clear
    Range("a1") = "月工时汇总表"
    Range("a2").Resize(1, m) = d.keys
    Range("a3").Resize(UBound(brr, 2), m) = Application.Transpose(brr)
End Sub
我这个程序做的有问题吗？为什么不好用呢，求高手进来看看谢谢