zoukankan      html  css  js  c++  java
  • 20170923xlVBA_UpdateClientDetailSQL_Dictionary

    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
    

      

  • 相关阅读:
    SpringBoot中mybatis配置自动转换驼峰标识没有生效
    spring boot 配置动态刷新
    读书笔记——spring cloud 中 HystrixCommand的四种执行方式简述
    spring cloud 加入配置中心后的 部分 配置文件优先级
    spring boot 服务 正确关闭方式
    CentOS 6.4 安装 rabbitmq(3.6.15)
    CentOS 6.4 配置DNS
    CentOS 查看系统版本号
    服务治理的技术点
    【转载】C#中使用Average方法对List集合中相应元素求平均值
  • 原文地址:https://www.cnblogs.com/nextseven/p/7580079.html
Copyright © 2011-2022 走看看