Private Sub GetClientAccountList()    Dim EndRow As Long    Dim i As Long, j As Long    Dim m As Long, n As Long    Dim TakeSum As Double, PaySum As Double    Dim NotTake As Double, NotPay As Double    Dim HasTake As Double, HasPay As Double    Dim FileName As String    Dim FolderPath As String    Dim FilePath As String    Dim Rng As Range    Dim Arr As Variant    Dim Brr(), iRows        Dim Crr()    ReDim Crr(1 To 4, 1 To 1)    Index = 0        Const HeadRow As Long = 1    Dim NewSht As Worksheet    Dim Wb As Workbook    Dim NewWb As Workbook    Dim Sht As Worksheet                    Set Wb = Application.ThisWorkbook    FolderPath = Wb.Path & "\先达对账单\"    Dim dClient As Object    Dim dTrade As Object    Set dClient = CreateObject("Scripting.Dictionary")    Set dTrade = CreateObject("Scripting.Dictionary")    Set Sht = Wb.Worksheets("明细")    With Sht        EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row        Set Rng = .Range("A2:T" & EndRow)        Arr = Rng.Value        For i = LBound(Arr) To UBound(Arr)            Key = CStr(Arr(i, 1))            If Key <> "" Then dClient(Key) = dClient(Key) & i & ";"            Key = CStr(Arr(i, 11))            If Key <> "" Then dTrade(Key) = dTrade(Key) & i & ";"        Next i    End With    Count = 0    For Each onekey In dClient.Keys        If Not dTrade.exists(onekey) Then            ''''————————————————————————————            NotTake = 0            '单纯客户                        Set NewWb = Application.Workbooks.Add            FileName = onekey & "--先达 2017对账单"            FilePath = FolderPath & FileName & ".xlsx"            On Error Resume Next            Kill FilePath            On Error GoTo 0            Set NewSht = NewWb.Worksheets(1)            NewSht.Name = FileName                        With NewSht                .Cells.Clear                With .Range("A1:J1")                    .Value = Array("客户", "日期", "行程", "车型", "记账RMB", "记账HK", "现收RMB", "现收HK", "先达应收", "先达应付")                    .Font.Bold = True                    With .Interior                        .Pattern = xlSolid                        .Color = 16763443                    End With                End With                iRows = Split(dClient(onekey), ";")                RowCount = UBound(iRows)                'Debug.Print RowCount                ReDim Brr(1 To RowCount, 1 To 12)                m = 0                For i = LBound(iRows) To UBound(iRows) - 1                    m = m + 1                    For j = 1 To 8                        Brr(m, j) = Arr(iRows(i), j)                    Next j                    Brr(m, 9) = Brr(m, 5) + Brr(m, 6) - Brr(m, 7) - Brr(m, 8)                    NotTake = NotTake + Brr(m, 9)                Next i                .Range("A2").Resize(RowCount, 10).Value = Brr                EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row                                desrow = EndRow + 1                .Cells(desrow, "I").Value = NotTake                .Cells(desrow + 1, "I").Value = NotTake                .Cells(desrow + 1, "I").Resize(1, 2).Merge                .Cells(desrow + 1, "C").Value = "合计"                SetBorders .UsedRange                SetCenters .UsedRange                .UsedRange.WrapText = True                .UsedRange.Columns.AutoFit                .UsedRange.Rows(1).RowHeight = 20                .UsedRange.Range("A:A").ColumnWidth = 10                .UsedRange.Range("B:B").ColumnWidth = 8                .UsedRange.Range("D:D").ColumnWidth = 6                .UsedRange.Range("E:J").ColumnWidth = 9                .UsedRange.Range("E:E,G:G,I:J").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                '.UsedRange.Range("G:G").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                .UsedRange.Range("F:F,H:H").NumberFormat = "\$#,##0;-\$#,##0"                '.UsedRange.Range("H:H").NumberFormat = "\$#,##0;-\$#,##0"                '.UsedRange.Range("I:J").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                .UsedRange.Columns(3).ColumnWidth = 40                 .UsedRange.Columns(3).HorizontalAlignment = xlLeft                .Range("C65536").End(xlUp).HorizontalAlignment = xlCenter                SetCenters .Range("C1")            End With            NewWb.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False            NewWb.Close True            Index = Index + 1            ReDim Preserve Crr(1 To 4, 1 To Index)            Crr(1, Index) = onekey '公司名称            Crr(2, Index) = NotTake            Crr(3, Index) = 0            Crr(4, Index) = NotTake        Else            ''''————————————————————————————            NotTake = 0            NotPay = 0                        '同行客户            Set NewWb = Application.Workbooks.Add            FileName = onekey & "--先达 2017对账单"            FilePath = FolderPath & FileName & ".xlsx"            On Error Resume Next            Kill FilePath            On Error GoTo 0            Set NewSht = NewWb.Worksheets(1)            NewSht.Name = FileName            With NewSht                .Cells.Clear                With .Range("A1:J1")                    .Value = Array("客户", "日期", "行程", "车型", "记账RMB", "记账HK", "现收RMB", "现收HK", "先达应收", "先达应付")                    .Font.Bold = True                    With .Interior                        .Pattern = xlSolid                        .Color = 16763443                    End With                End With                iRows = Split(dClient(onekey), ";")                RowCount = UBound(iRows)                'Debug.Print RowCount                ReDim Brr(1 To RowCount, 1 To 12)                m = 0                For i = LBound(iRows) To UBound(iRows) - 1                    m = m + 1                    For j = 1 To 8                        Brr(m, j) = Arr(iRows(i), j)                    Next j                    Brr(m, 9) = Brr(m, 5) + Brr(m, 6) - Brr(m, 7) - Brr(m, 8)                    NotTake = NotTake + Brr(m, 9)                Next i                .Range("A2").Resize(RowCount, 10).Value = Brr                                '空一行                EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 2                ''''————————————————————————————                                '外调同行                iRows = Split(dTrade(onekey), ";")                RowCount = UBound(iRows)                'Debug.Print RowCount                ReDim Brr(1 To RowCount, 1 To 12)                m = 0                For i = LBound(iRows) To UBound(iRows) - 1                    m = m + 1                    Brr(m, 1) = "先达"                    For j = 2 To 4                        Brr(m, j) = Arr(iRows(i), j)                    Next j                    For j = 5 To 8                        Brr(m, j) = Arr(iRows(i), j + 7)                    Next j                                        Brr(m, 10) = Brr(m, 5) + Brr(m, 6) - Brr(m, 7) - Brr(m, 8)                    NotPay = NotPay + Brr(m, 10)                                    Next i                .Range("A" & EndRow).Resize(RowCount, 10).Value = Brr                '空一行                EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1                                desrow = EndRow + 1                                .Cells(desrow, "I").Value = NotTake                .Cells(desrow, "J").Value = NotPay                                .Cells(desrow + 1, "I").Value = NotTake - NotPay                .Cells(desrow + 1, "I").Resize(1, 2).Merge                                .Cells(desrow + 1, "C").Value = "合计"                                SetBorders .UsedRange                SetCenters .UsedRange                .UsedRange.WrapText = True                .UsedRange.Columns.AutoFit                .UsedRange.Rows(1).RowHeight = 20                .UsedRange.Range("A:A").ColumnWidth = 10                .UsedRange.Range("B:B").ColumnWidth = 8                .UsedRange.Range("D:D").ColumnWidth = 6                .UsedRange.Range("E:J").ColumnWidth = 9                .UsedRange.Range("E:E,G:G,I:J").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                '.UsedRange.Range("G:G").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                .UsedRange.Range("F:F,H:H").NumberFormat = "\$#,##0;-\$#,##0"                '.UsedRange.Range("H:H").NumberFormat = "\$#,##0;-\$#,##0"                '.UsedRange.Range("I:J").NumberFormat = """￥""#,##0;[Red]""￥""-#,##0"                .UsedRange.Columns(3).ColumnWidth = 40                 .UsedRange.Columns(3).HorizontalAlignment = xlLeft                .Range("C65536").End(xlUp).HorizontalAlignment = xlCenter                SetCenters .Range("C1")            End With                        NewWb.SaveAs FileName:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False            NewWb.Close True                                    Index = Index + 1            ReDim Preserve Crr(1 To 4, 1 To Index)            Crr(1, Index) = onekey '公司名称            Crr(2, Index) = NotTake            Crr(3, Index) = NotPay            Crr(4, Index) = NotTake - NotPay                    End If        'If Count = 1 Then Exit For    Next onekey        For Each onekey In dTrade.Keys        If Not dTrade.exists(onekey) Then            Debug.Print "仅同行"; onekey        End If    Next onekey        Set Sht = Wb.Worksheets("账单汇总")    With Sht        .UsedRange.Offset(1).Clear        Set Rng = .Range("A2")        Set Rng = Rng.Resize(UBound(Crr, 2), UBound(Crr))        Rng.Value = Application.WorksheetFunction.Transpose(Crr)        SetBorders .UsedRange        SetCenters .UsedRange        .UsedRange.Columns.AutoFit    End With        Set Wb = Nothing    Set NewWb = Nothing    Set Sht = Nothing    Set NewSht = Nothing    Set Rng = Nothing        Set dClient = Nothing    Set dTrade = Nothing    End SubPublic Sub SetBorders(ByVal Rng As Range)    With Rng.Borders        .LineStyle = xlContinuous        .ColorIndex = xlAutomatic        .TintAndShade = 0        .Weight = xlThin    End WithEnd SubPublic Sub SetCenters(ByVal Rng As Range)    With Rng        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter    End WithEnd Sub