VBA与SQL融合实现Excel高效数据处理

1. VBA与SQL融合的数据处理方案解析

在办公自动化领域，VBA与SQL的结合堪称数据处理的最佳拍档。作为一名长期从事Excel自动化开发的工程师，我发现这种组合能完美解决日常工作中的数据难题。VBA擅长操控Office组件和流程自动化，SQL则专精于高效数据查询与处理，二者结合后处理十万级数据的速度比纯VBA快10倍不止。

核心优势主要体现在三个方面：首先，它能突破Excel原生函数和透视表的数据处理限制；其次，可以实现跨表关联、复杂聚合等高级操作；最后，整个过程可以实现完全自动化，无需人工干预。特别适合需要定期处理销售报表、财务数据、库存清单等场景。

2. 基础环境配置与核心原理

2.1 ADO组件的工作原理

ADO（ActiveX Data Objects）是微软提供的数据访问接口，相当于VBA与数据源之间的翻译官。它的工作原理可以类比为国际会议的同声传译：VBA用ADO"说"出SQL指令，ADO将指令"翻译"成数据源能理解的语言，数据源执行后将结果再通过ADO"传回"给VBA。

这种架构的优势在于：

• 统一接口：无论连接Excel、Access还是SQL Server，都使用相同的ADO对象模型
• 高效传输：采用二进制数据流，比直接操作单元格快得多
• 灵活扩展：支持几乎所有主流数据库系统

2.2 开发环境准备步骤

1. 启用ADO组件库：

   • 按Alt+F11打开VBA编辑器
   • 菜单栏选择"工具"→"引用"
   • 勾选"Microsoft ActiveX Data Objects 6.1 Library"
   • 建议同时勾选"Microsoft Scripting Runtime"（后续文件操作有用）

2. 验证安装是否成功：

vba复制Sub TestADO()
    Dim conn As Object
    On Error Resume Next
    Set conn = CreateObject("ADODB.Connection")
    If Err.Number = 0 Then
        MsgBox "ADO组件可用"
    Else
        MsgBox "请先启用ADO引用"
    End If
    On Error GoTo 0
End Sub

注意：如果找不到6.1版本，选择最高版本即可。不同版本间核心功能一致，高版本主要增加了一些高级特性。

3. 核心操作流程详解

3.1 标准操作模板

以下是一个完整的VBA+SQL操作模板，建议保存为代码片段：

vba复制Sub SQL_Operation_Template()
    ' 声明对象变量
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sqlStr As String
    Dim startTime As Double
    
    ' 记录开始时间（性能测试用）
    startTime = Timer
    
    On Error GoTo ErrorHandler
    
    ' 步骤1：建立连接
    conn.Open GetConnectionString("Excel") ' 自定义函数获取连接字符串
    
    ' 步骤2：构建SQL语句
    sqlStr = "SELECT [产品名称], SUM([销售额]) " & _
             "FROM [销售数据$] " & _
             "WHERE [日期] BETWEEN #2024/1/1# AND #2024/3/31# " & _
             "GROUP BY [产品名称] " & _
             "HAVING SUM([销售额]) > 10000 " & _
             "ORDER BY SUM([销售额]) DESC"
    
    ' 步骤3：执行查询
    rs.Open sqlStr, conn, adOpenStatic, adLockReadOnly
    
    ' 步骤4：处理结果
    If Not rs.EOF Then
        ' 清空目标区域
        Sheet2.Range("A2:C1000").ClearContents
        ' 输出列标题
        Sheet2.Range("A1:C1") = Array("排名", "产品名称", "销售额")
        ' 输出数据
        Sheet2.Range("A2").CopyFromRecordset rs
        ' 添加排名
        Dim lastRow As Long
        lastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastRow
            Sheet2.Cells(i, 1) = i - 1
        Next i
    Else
        MsgBox "没有查询到符合条件的数据"
    End If
    
    ' 步骤5：收尾工作
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    
    ' 显示耗时
    MsgBox "查询完成，耗时：" & Round(Timer - startTime, 2) & "秒"
    Exit Sub
    
ErrorHandler:
    MsgBox "错误 " & Err.Number & ": " & Err.Description
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close
End Sub

Function GetConnectionString(dataSourceType As String) As String
    Select Case dataSourceType
        Case "Excel"
            GetConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                 "Data Source=" & ThisWorkbook.FullName & ";" & _
                                 "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
        Case "Access"
            GetConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                 "Data Source=C:\Data\MyDB.accdb;" & _
                                 "Persist Security Info=False;"
        ' 可添加其他数据源类型
    End Select
End Function

3.2 连接字符串详解

连接字符串是VBA与数据源建立连接的关键，不同数据源需要不同的连接字符串：

1. Excel工作簿：

code复制"Provider=Microsoft.ACE.OLEDB.12.0;
Data Source=C:\Data\Sales.xlsx;
Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"

• HDR=YES：第一行作为列名
• IMEX=1：混合数据类型模式
• Excel 12.0 Xml：适用于.xlsx文件

2. Access数据库：

code复制"Provider=Microsoft.ACE.OLEDB.12.0;
Data Source=C:\Data\Inventory.accdb;
Persist Security Info=False;"

3. SQL Server：

code复制"Provider=SQLOLEDB;
Data Source=192.168.1.100\SQLEXPRESS;
Initial Catalog=Northwind;
User ID=sa;
Password=123456;"

重要提示：实际使用时需要将密码等敏感信息替换为实际值，建议将这些连接字符串存储在单独的配置表中，而不是硬编码在VBA中。

4. 高级应用场景实战

4.1 多工作簿数据合并

假设需要合并多个结构相同的Excel文件：

vba复制Sub MergeMultipleWorkbooks()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sqlStr As String
    Dim folderPath As String
    Dim file As String
    
    ' 设置文件夹路径
    folderPath = "C:\SalesReports\"
    file = Dir(folderPath & "*.xlsx")
    
    ' 创建临时工作表存放结果
    Dim tempSheet As Worksheet
    Set tempSheet = ThisWorkbook.Sheets.Add
    tempSheet.Name = "MergedData"
    
    ' 初始化连接
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & folderPath & file & _
              ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
    
    ' 构建UNION ALL查询
    sqlStr = ""
    Do While file <> ""
        If sqlStr <> "" Then sqlStr = sqlStr & " UNION ALL "
        sqlStr = sqlStr & "SELECT * FROM [Sheet1$] IN '" & folderPath & file & "'"
        file = Dir()
    Loop
    
    ' 执行查询
    rs.Open sqlStr, conn
    
    ' 输出结果
    tempSheet.Range("A1").CopyFromRecordset rs
    
    ' 添加来源文件名
    Dim lastRow As Long
    lastRow = tempSheet.Cells(tempSheet.Rows.Count, "A").End(xlUp).Row
    tempSheet.Cells(1, rs.Fields.Count + 1) = "SourceFile"
    For i = 2 To lastRow
        tempSheet.Cells(i, rs.Fields.Count + 1) = file
    Next i
    
    ' 清理
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Sub

4.2 动态参数查询

创建交互式查询界面：

vba复制Sub DynamicQuery()
    Dim conn As New ADODB.Connection
    Dim cmd As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim sqlStr As String
    
    ' 获取用户输入
    Dim startDate As String
    Dim endDate As String
    Dim minAmount As Double
    
    startDate = InputBox("请输入开始日期(YYYY/MM/DD):", "查询条件", "2024/1/1")
    endDate = InputBox("请输入结束日期(YYYY/MM/DD):", "查询条件", "2024/12/31")
    minAmount = InputBox("请输入最小金额:", "查询条件", "1000")
    
    ' 建立连接
    conn.Open GetConnectionString("Excel")
    
    ' 使用参数化查询
    sqlStr = "SELECT [订单号], [客户名称], [订单日期], [金额] " & _
             "FROM [订单数据$] " & _
             "WHERE [订单日期] BETWEEN ? AND ? " & _
             "AND [金额] >= ? " & _
             "ORDER BY [金额] DESC"
    
    ' 配置Command对象
    Set cmd.ActiveConnection = conn
    cmd.CommandText = sqlStr
    cmd.CommandType = adCmdText
    
    ' 添加参数
    cmd.Parameters.Append cmd.CreateParameter("StartDate", adDate, adParamInput, , CDate(startDate))
    cmd.Parameters.Append cmd.CreateParameter("EndDate", adDate, adParamInput, , CDate(endDate))
    cmd.Parameters.Append cmd.CreateParameter("MinAmount", adCurrency, adParamInput, , minAmount)
    
    ' 执行查询
    Set rs = cmd.Execute
    
    ' 输出结果
    Sheet2.Range("A2:D10000").ClearContents
    If Not rs.EOF Then
        Sheet2.Range("A2").CopyFromRecordset rs
        ' 添加标题
        Sheet2.Range("A1:D1") = Array("订单号", "客户名称", "日期", "金额")
        ' 格式化
        Sheet2.Columns("C").NumberFormat = "yyyy/mm/dd"
        Sheet2.Columns("D").NumberFormat = "#,##0.00"
    Else
        MsgBox "没有找到符合条件的记录"
    End If
    
    ' 清理
    rs.Close
    conn.Close
    Set rs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
End Sub

5. 性能优化与错误处理

5.1 提升查询效率的技巧

1. 索引优化：

   • 对经常用于WHERE条件的列创建索引
   • 在Access中：CREATE INDEX idx_name ON table_name(column_name)
   • 在SQL Server中：CREATE NONCLUSTERED INDEX idx_name ON table_name(column_name)

2. 查询优化：

   vba复制' 不推荐 - 全表扫描
   sqlStr = "SELECT * FROM [大表$]"
   
   ' 推荐 - 只选择需要的列
   sqlStr = "SELECT 列1, 列2 FROM [大表$] WHERE 条件"
   

3. 批量操作：

   vba复制' 单条插入（慢）
   For i = 1 To 1000
       conn.Execute "INSERT INTO [表$] VALUES('值" & i & "')"
   Next i
   
   ' 批量插入（快）
   sqlStr = "INSERT INTO [表$] VALUES "
   For i = 1 To 1000
       If i > 1 Then sqlStr = sqlStr & ","
       sqlStr = sqlStr & "('值" & i & "')"
   Next i
   conn.Execute sqlStr
   

5.2 完善的错误处理机制

vba复制Sub SafeQuery()
    On Error GoTo ErrorHandler
    
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    ' 尝试连接
    conn.Open "无效的连接字符串"
    
    ' 执行查询
    rs.Open "SELECT * FROM 不存在的表", conn
    
    Exit Sub
    
ErrorHandler:
    ' 记录错误
    Dim errMsg As String
    errMsg = "错误发生在 " & VBE.ActiveCodePane.CodeModule & " 第 " & Erl & " 行" & vbCrLf & _
             "错误号: " & Err.Number & vbCrLf & _
             "描述: " & Err.Description
    
    ' 写入日志文件
    Dim logFile As Integer
    logFile = FreeFile
    Open "C:\ErrorLog.txt" For Append As #logFile
    Print #logFile, Now & " - " & errMsg
    Close #logFile
    
    ' 显示友好提示
    MsgBox "操作失败，错误信息已记录。请联系技术支持。", vbExclamation
    
    ' 清理资源
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    End If
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
        Set conn = Nothing
    End If
End Sub

6. 实际案例：销售数据分析系统

6.1 系统功能设计

1. 数据导入模块：

   • 支持Excel/CSV文件导入
   • 自动检测数据结构
   • 数据清洗与转换

2. 核心分析模块：

   • 销售趋势分析（按日/周/月/季）
   • 区域对比分析
   • 产品排名分析
   • 客户价值分析

3. 报表输出模块：

   • 自动生成PDF报告
   • 邮件自动发送
   • 数据可视化图表

6.2 核心代码实现

vba复制' 主分析过程
Sub RunSalesAnalysis()
    Dim analysisStart As Double
    analysisStart = Timer
    
    ' 初始化
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    ' 执行各模块
    ImportSalesData
    CleanAndTransformData
    GenerateAnalysisReports
    ExportToPDF
    SendEmailNotification
    
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "分析完成，总耗时: " & Format((Timer - analysisStart) / 60, "0.00") & " 分钟"
End Sub

' 数据导入子过程
Sub ImportSalesData()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sqlStr As String
    
    ' 清空现有数据
    Sheets("RawData").UsedRange.ClearContents
    
    ' 连接源数据文件
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=C:\Data\SalesSource.xlsx;" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
    
    ' 构建查询
    sqlStr = "SELECT [OrderID], [OrderDate], [CustomerID], " & _
             "[ProductID], [Quantity], [UnitPrice], [Region] " & _
             "FROM [Orders$] " & _
             "WHERE [OrderDate] BETWEEN #2023/1/1# AND #2023/12/31#"
    
    ' 执行查询
    rs.Open sqlStr, conn
    
    ' 导入数据
    If Not rs.EOF Then
        Sheets("RawData").Range("A1").CopyFromRecordset rs
        ' 添加标题
        Sheets("RawData").Range("A1:G1") = _
            Array("订单号", "日期", "客户ID", "产品ID", "数量", "单价", "区域")
    End If
    
    ' 关闭连接
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
End Sub

7. 常见问题解决方案

7.1 连接问题排查

1. "找不到可安装的ISAM"错误：

   • 检查文件路径是否正确
   • 确认文件没有被其他程序占用
   • 尝试使用完整路径而非相对路径

2. "操作必须使用可更新的查询"错误：

   • 检查文件是否只读
   • 确认连接字符串没有包含ReadOnly=1
   • 确保有足够的文件权限

3. "内存不足"错误：

   • 减少返回的数据量（使用WHERE条件）
   • 只选择必要的列
   • 分批次处理大数据集

7.2 数据类型问题

1. 日期格式问题：

   • Excel SQL使用#MM/DD/YYYY#格式
   • Access SQL使用#MM/DD/YYYY#格式
   • SQL Server使用'YYYY-MM-DD'格式

2. 文本包含单引号：

   vba复制' 错误写法
   sqlStr = "SELECT * FROM [表$] WHERE 名称='" & userName & "'"
   
   ' 正确写法
   userName = Replace(userName, "'", "''")
   sqlStr = "SELECT * FROM [表$] WHERE 名称='" & userName & "'"
   

3. 处理NULL值：

   vba复制' 检查NULL
   sqlStr = "SELECT * FROM [表$] WHERE 列 IS NULL"
   
   ' 替换NULL
   sqlStr = "SELECT IIF(列 IS NULL, '空值', 列) FROM [表$]"
   

8. 扩展应用与进阶技巧

8.1 与Power Query集成

vba复制Sub RefreshPowerQuery()
    Dim qry As WorkbookQuery
    Dim formula As String
    
    ' 获取现有查询
    Set qry = ThisWorkbook.Queries("SalesData")
    
    ' 更新SQL语句
    formula = "let" & vbCrLf & _
              "    Source = Excel.Workbook(File.Contents(""C:\Data\Source.xlsx""), null, true)," & vbCrLf & _
              "    Sheet1_Sheet = Source{[Item=""Sheet1"",Kind=""Sheet""]}[Data]," & vbCrLf & _
              "    #""Promoted Headers"" = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true])," & vbCrLf & _
              "    #""Filtered Rows"" = Table.SelectRows(#""Promoted Headers"", each [Amount] > 1000)" & vbCrLf & _
              "in" & vbCrLf & _
              "    #""Filtered Rows"""
    
    ' 更新查询定义
    qry.formula = formula
    
    ' 刷新查询
    ThisWorkbook.Connections("查询 - SalesData").Refresh
End Sub

8.2 创建动态报表

vba复制Sub GenerateDynamicReport()
    Dim pivotCache As PivotCache
    Dim pivotTable As PivotTable
    Dim sourceData As String
    
    ' 确定数据源范围
    sourceData = "RawData!A1:G" & Sheets("RawData").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 创建数据透视表缓存
    Set pivotCache = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=sourceData)
    
    ' 创建数据透视表
    Set pivotTable = pivotCache.CreatePivotTable( _
        TableDestination:="Report!R3C1", _
        TableName:="SalesPivot")
    
    ' 配置数据透视表
    With pivotTable
        ' 添加行字段
        .AddFields RowFields:="Region", ColumnFields:="OrderDate"
        
        ' 添加值字段
        .AddDataField .PivotFields("Quantity"), "总数量", xlSum
        .AddDataField .PivotFields("UnitPrice"), "平均单价", xlAverage
        
        ' 设置日期分组
        .PivotFields("OrderDate").AutoGroup
    End With
    
    ' 创建图表
    Dim chartObj As ChartObject
    Set chartObj = Sheets("Report").ChartObjects.Add( _
        Left:=Sheets("Report").Range("A20").Left, _
        Top:=Sheets("Report").Range("A20").Top, _
        Width:=500, _
        Height:=300)
    
    ' 配置图表
    With chartObj.Chart
        .SetSourceData Source:=pivotTable.TableRange1
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "销售分析报告"
    End With
End Sub

9. 安全最佳实践

9.1 防止SQL注入

vba复制' 不安全的方式
sqlStr = "SELECT * FROM [Users$] WHERE Username='" & txtUserName & "' AND Password='" & txtPassword & "'"

' 安全的方式 - 参数化查询
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandText = "SELECT * FROM [Users$] WHERE Username=? AND Password=?"
cmd.Parameters.Append cmd.CreateParameter("username", adVarChar, adParamInput, 50, txtUserName)
cmd.Parameters.Append cmd.CreateParameter("password", adVarChar, adParamInput, 50, txtPassword)
Set rs = cmd.Execute

9.2 连接信息保护

1. 加密存储连接字符串：

vba复制Function GetSecureConnectionString() As String
    Dim encryptedStr As String
    encryptedStr = "U2FsdGVkX1+Wv2ZJ5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5J5