工作表查询数据代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nRow%, Arr(), Brr(), nYue%, m%
    Dim ds As Object, n%
    Set ds = CreateObject("Scripting.Dictionary")
    If Target.Address <> "$H$2" Then Exit Sub
    nYue = Val(Target.Value)
    With Sheets("设置")
        Brr = .Range("e1").CurrentRegion.Value
        For i = 1 To UBound(Brr)
            ds(Brr(i, 2)) = Brr(i, 1)
        Next
        Brr = .Range("i1").CurrentRegion.Value
        For i = 1 To UBound(Brr)
            ds(Left(Brr(i, 2), 2)) = Brr(i, 1) '品牌取前2个字，不知有没有问题
        Next
    End With
    With Sheets("数据")
        nRow = .Range("a1048576").End(xlUp).Row
        Arr = .Range("a1:i" & nRow).Value
    End With
    For i = 2 To nRow
        If Month(Arr(i, 1)) = nYue And ds(Arr(i, 3)) And ds(Left(Arr(i, 6), 2)) Then
            n = ds("_" & Arr(i, 3))
            If n = 0 Then
                m = m + 1
                n = m
                ds("_" & Arr(i, 3)) = m
                Arr(n, 1) = Arr(i, 3)
            End If
            Arr(n, 2) = Val(Arr(n, 2)) + Arr(i, 7)
            Arr(n, 4) = Val(Arr(n, 4)) + Arr(i, 9)
        End If
    Next
    For i = 1 To m
        Arr(i, 3) = Arr(i, 4) / Arr(i, 2)
    Next
    Application.EnableEvents = False
    With Me
        nRow = .Range("g1048576").End(xlUp).Row
        If nRow > 3 Then .Range("f4:j" & nRow).ClearContents
        If m > 0 Then
            .Range("g4").Resize(m, 4).Value = Arr
        End If
    End With
    Application.EnableEvents = True
End Sub