Sub UpdateClientDetailWGQ()

    Dim Wb As Workbook

    Dim Sht As Worksheet

    Dim Rng As Range

    Dim Arr As Variant

    Dim Brr As Variant

    Dim dData As Object

    Dim dRow As Object

    Dim Key As String

    Dim OneKey

    Set dData = CreateObject("Scripting.Dictionary")

    Set dRow = CreateObject("Scripting.Dictionary")

    Set Wb = Application.ThisWorkbook

    'Set Sht = Wb.Worksheets("CPU")

    '选择文件

    Dim FilePath As String

    With Application.FileDialog(msoFileDialogFilePicker)

        .AllowMultiSelect = False

        .InitialFileName = ThisWorkbook.Path

        .Title = "请选择单个Excel工作簿"

        .Filters.Clear

        .Filters.Add "Excel工作簿", "*.xls*"

        If .Show = -1 Then

            FilePath = .SelectedItems(1)

        Else

            MsgBox "您没有选中任何文件夹，本次汇总中断！"

            Exit Sub

        End If

    End With

    '查询更新内容

    For Each Sht In Wb.Worksheets

        SQL = "SELECT F2,F9,F10,F11,F12,F13,F14,F15 FROM [" & Sht.Name & "$A2:O] WHERE F9 IS NOT NULL"

        Debug.Print SQL

        If RecordExistsRunSQL(FilePath, SQL) Then

            Arr = RunSQLReturnArray(FilePath, SQL)

            For j = LBound(Arr, 2) To UBound(Arr, 2)

                Key = CStr(Arr(0, j))

                'For i = LBound(Arr) To UBound(Arr)

                'Debug.Print Key

                dData(Key) = Array(Arr(1, j), Arr(2, j), Arr(3, j), Arr(4, j), Arr(5, j), Arr(6, j), Arr(7, j))

                'Next i

            Next j

            With Sht

                endrow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row

                Set Rng = .Range("A2:O" & endrow)

                Brr = Rng.Value

                For i = LBound(Brr) To UBound(Brr)

                    Key = CStr(Brr(i, 2))

                    'Debug.Print Key

                    dRow(Key) = i

                Next i

                For Each OneKey In dData.keys

                    If dRow.exists(OneKey) Then

                        ar = dData(OneKey)

                        For j = LBound(ar) To UBound(ar)

                            Brr(dRow(OneKey), j + 9) = ar(j)

                        Next j

                    End If

                Next OneKey

                Rng.Value = Brr

            End With

        End If

    Next Sht

    Set Wb = Nothing

    Set dData = Nothing

    Set dRow = Nothing

    Set Sht = Nothing

    Set Rng = Nothing

End Sub

Public Function RunSQLReturnArray(ByVal DataPath As String, ByVal SQL As String) As Variant()

'对传入数据源地址进行判断

    If Len(DataPath) = 0 Or Len(Dir(DataPath)) = 0 Then

        MsgBox "数据源地址为空或者数据源文件不存在！", vbInformation, "NS Excel Studio"

        Exit Function

    End If

    '对传入SQL语句进行判断

    If Len(SQL) = 0 Then _

 MsgBox "SQL语句不能为空！", vbInformation, "NS Excel Studio": Exit Function

    '对象变量声明

    Dim CNN As Object

    Dim RS As Object

        '数据库引擎——Excel作为数据源

    Dim DATA_ENGINE   As String

    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接

    Case Is <= 11

       DATA_ENGINE = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='Excel 8.0;HDR=no;IMEX=2';Data Source="

    Case Is >= 12

        DATA_ENGINE = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=no;IMEX=2'; Data Source= "

    End Select

    '数据库引擎——Excel作为数据源

    'Const DATA_ENGINE As String = "Provider=Microsoft.ACE.OLEDB.12.0;" & _

          "Extended Properties='Excel 12.0;HDR=YES;IMEX=2'; Data Source= "

    '创建ADO Connection 连接器 实例

    Set CNN = CreateObject("ADODB.Connection")

    'On Error Resume Next

    '创建 ADO RecordSet  记录集 实例

    'Set RS = CreateObject("ADODB.RecordSet")

    '连接数据源

    CNN.Open DATA_ENGINE & DataPath

    '执行查询 返回记录集

    ' RS.Open SQL, CNN, 1, 1

    Set RS = CNN.Execute(SQL)

    RunSQLReturnArray = RS.GetRows()

    '关闭记录集

    'RS.Close

    '关闭连接器

    CNN.Close

    '释放对象

    Set RS = Nothing

    Set CNN = Nothing

End Function

Public Function RecordExistsRunSQL(ByVal DataPath As String, ByVal SQL As String) As Boolean

'对传入数据源地址进行判断

    If Len(DataPath) = 0 Or Len(Dir(DataPath)) = 0 Then

        RecordExistsRunSQL = False

        MsgBox "数据源地址为空或者数据源文件不存在！", vbInformation, "NS Excel Studio"

        Exit Function

    End If

    '对传入SQL语句进行判断

    If Len(SQL) = 0 Then

        RecordExistsRunSQL = False

        MsgBox "SQL语句不能为空！", vbInformation, "NS Excel Studio"

        Exit Function

    End If

    '对象变量声明

    Dim CNN As Object

    Dim RS As Object

        '数据库引擎——Excel作为数据源

    Dim DATA_ENGINE   As String

    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接

    Case Is <= 11

       DATA_ENGINE = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='Excel 8.0;HDR=no;IMEX=2';Data Source="

    Case Is >= 12

        DATA_ENGINE = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=no;IMEX=2'; Data Source= "

    End Select

    '数据库引擎——Excel作为数据源

    'Const DATA_ENGINE As String = "Provider=Microsoft.ACE.OLEDB.12.0;" & _

          "Extended Properties='Excel 12.0;HDR=YES;IMEX=2'; Data Source= "

    '创建ADO Connection 连接器 实例

    Set CNN = CreateObject("ADODB.Connection")

    On Error Resume Next

    '创建 ADO RecordSet  记录集 实例

    Set RS = CreateObject("ADODB.RecordSet")

    '连接数据源

    CNN.Open DATA_ENGINE & DataPath

    '执行查询 返回记录集

    RS.Open SQL, CNN, 1, 1

    '返回函数结果

    If RS.RecordCount > 0 Then

        RecordExistsRunSQL = True

    Else

        RecordExistsRunSQL = False

    End If

    '关闭记录集

    RS.Close

    '关闭连接器

    CNN.Close

    '释放对象

    Set RS = Nothing

    Set CNN = Nothing

End Function