各位大神，帮忙帮忙，研究了，不知道哪里越界了，是明细表，生成对应表

冷冷0

Private Sub Worksheet_Change(ByVal T As Range)
    Dim KeHu  As String, hu As String, Bh As String, sh As Worksheet
    Dim KS As Date, JS As Date, RQ As Date, d As Object, ar, s$
    Set sh = ThisWorkbook.Sheets("总表")
    With T
        If .Address = "$B$2" Or .Address = "$F$2" Or .Address = "$F$3" Then
            KeHu = Me.Range("B2").Value
            KS = Me.Range("F2").Value
            JS = Me.Range("F3").Value
            If sh.AutoFilterMode Then sh.AutoFilterMode = False
            r = sh.Cells(sh.Rows.Count, "a").End(xlUp).Row
            If r <= 3 Then Exit Sub
            Set d = CreateObject("scripting.dictionary")
            ar = sh.Range("a2:AZ" & r)
            For i = 2 To UBound(ar)
                hu = ar(i, 52)
                RQ = ar(i, 1)
                Bh = ar(i, 1)
                If hu = KeHu Then
                    If RQ >= KS And RQ <= JS Then
                        If Bh <> "" Then
                            s = Bh & "☆" & ar(i, 2) & ar(i, 3) & ar(i, 4) & ar(i, 8) & ar(i, 25)
                            If d.exists(s) = False Then
                               d(s) = Array(ar(i, 1), ar(i, 2), ar(i, 3), ar(i, 4), ar(i, 5), ar(i, 8), ar(i, 25), ar(i, 27), ar(i, 28), ar(i, 29), ar(i, 30), ar(i, 31), ar(i, 32), ar(i, 33), ar(i, 34), ar(i, 35), ar(i, 49), ar(i, 50), ar(i, 45))       '日期,摘要,车号,货号,车数,品名规格,交货点,吨数,价格价,运价格款,业务价,业务款,税点,税款,应收结算价,应收结算金额,汇款,退款,折扣金额
                            Else
                                br = d(s)
                                br(4) = br(4) + ar(i, 5)
                                br(7) = br(7) + ar(i, 27)
                                br(9) = br(9) + ar(i, 29)
                                br(11) = br(11) + ar(i, 31)
                                br(13) = br(13) + ar(i, 33)
                                br(15) = br(15) + ar(i, 35)
                                br(16) = br(16) + ar(i, 49)
                                d(s) = br
                            End If
                        End If
                    End If
                End If
            Next
        Else
            Exit Sub
        End If
    End With
    If d.Count Then
        With Me
            .Range("A7:S10000") = ""
            .Range("A7").Resize(d.Count, 19) = Application.Rept(d.items, 1)
        End With
    End If
End Sub

3190496160

上传附件才可能把你测试代码的

冷冷0

3190496160 发表于 2020-4-18 17:04
上传附件才可能把你测试代码的

好的谢谢，我马上传

冷冷0

冷冷0 发表于 2020-4-19 10:22
好的谢谢，我马上传

麻烦呢，谢谢，我都头疼啊

冷冷0

3190496160 发表于 2020-4-18 17:04
上传附件才可能把你测试代码的

你好，请问能帮忙看下吗