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 Sub

Public Sub SetBorders(ByVal Rng As Range)

    With Rng.Borders

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThin

    End With

End Sub

Public Sub SetCenters(ByVal Rng As Range)

    With Rng

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

    End With

End Sub