3个实操案例，学会用DeepSeek做VBA开发实现Excel自动化

Excel一定是每一个办公人绕不过去的坎------不论现在的AI有多牛逼、产品多有逼格，最终落到实操环节都离不开Excel。但Excel的操作本身就比较繁琐，更不用说大量重复性操作的场景，就令人很烦。

此时，我们可以借助VBA的工具，通过AI写代码的方式完成Excel自动化处理

1. VBA是什么？

VBA (Visual Basic for Applications) 是一种内嵌于微软Office应用程序（如Excel、Word、Access等）的编程语言。在Excel中，VBA允许用户编写脚本（称为"宏"）来自动执行任务、自定义功能、处理数据、创建用户界面等，从而扩展Excel的原生功能。

2. AI时代，为什么还要关注VBA？

想运行代码的话，就一定要有一个「编译器」，例如Python，可以用cursor

而VBA直接打开Excel就能用了，很方便。

也就是说，VBA 与Excel的深度集成：能够直接、便捷地操控Excel的每一个对象（工作簿、工作表、单元格、图表等） ，实现精细化的控制。

尤其是现在AI时代，对于Excel内部的重复性任务，通过VBA（尤其是AI辅助下）可以快速编写脚本实现自动化，投入产出比较高。

3. VBA、Python、SQL：在Excel数据处理中的定位与选择

在数据处理和自动化领域，除了VBA，Python和SQL也是常用的工具。怎么知道自己该用哪个工具？

• VBA优先：当主要工作场景在Excel内部的重复性任务自动化（如报表生成、格式调整、数据汇总），需要频繁操作Excel界面元素，或者快速实现轻量级自动化时。

• Python优先：当涉及复杂数据分析、大量数据处理、机器学习，或需要独立于Excel的自动化脚本时。可以通过Python处理数据后，结果输出到Excel。

• SQL优先：当数据存储在关系型数据库中，需要高效查询和管理这些数据时。查询结果可以导入Excel进行进一步分析或展示。

在实际工作中，这三个工具都是要搭配使用的：

例如，你可以用SQL从数据库提取原始数据，用Python进行复杂的清洗和分析，最后用VBA在Excel中生成格式化的报告并添加交互功能。

4. 用DeepSeek开发VBA

A. 打开Excel并显示"开发工具"选项卡

若Excel功能区未显示"开发工具"选项卡，请按以下步骤操作：

1. 点击"文件"菜单，选择"选项"。

2. 在"Excel选项"对话框中，选择左侧的"自定义功能区"。

3. 在右侧"主选项卡"列表中，确保勾选"开发工具"。

4. 点击"确定"。

B. 进入VBA编辑器 (VBE)

打开VBE（Visual Basic Editor）的方式：通过"开发工具"选项卡：点击功能区中的"Visual Basic"按钮。

c. VBE界面主要包含以下窗口：

• 工程资源管理器 (Project Explorer) ：显示当前打开的所有Excel工作簿及其包含的模块、类模块、窗体和工作表对象。

• 属性窗口 (Properties Window) ：显示在工程资源管理器中选定对象的属性。

• 代码窗口 (Code Window) ：用于输入、编辑和查看VBA代码。

• 立即窗口 (Immediate Window) ：用于执行单行代码、测试表达式和输出调试信息。

其实知道怎么操作就行了，界面的知道、不知道也没关系。

完成以上准备工作后，便可以开始借助AI编写VBA代码了。

实战操作

案例1：一键生成标准化的报告表头

问题背景：

在制作周报、月报等周期性报告时，经常需要重复设置相同的表头信息，如公司名称、报告标题、制表日期等，并统一其格式。手动操作不仅繁琐，也容易遗漏或格式不一。

操作步骤：

1. 明确需求，构建AI指令 (Prompt)：

1. 假设需求如下：在活动工作表的A1单元格填入"示例股份有限公司"，A2单元格填入"月度运营数据报告"，A3单元格填入当前日期。A1和A2单元格的文本要求加粗、字号14，并且单元格区域A1:C1和A2:C2分别进行合并居中。

参考提示词：

请编写一段Excel VBA代码，在当前活动工作表中执行以下操作：     
1. 在单元格A1输入文本"示例股份有限公司"。     
2. 在单元格A2输入文本"月度运营数据报告"。     
3. 在单元格A3输入今天的日期，格式为"YYYY-MM-DD"。     
4. 将单元格A1和A2中的文本设置为粗体，字号调整为14。     
5. 合并单元格区域A1:C1，并将其内容水平居中、垂直居中。     
6. 合并单元格区域A2:C2，并将其内容水平居中、垂直居中。     
7. 所有操作完成后，弹窗提示"报告表头已生成完毕"。

2. 利用DeepSeek生成VBA代码：

Sub GenerateReportHeader()
    Dim ws As Worksheet
    ' 获取当前活动工作表
    Set ws = ActiveSheet
    With ws
        ' 填写表头内容
        .Range("A1").Value = "示例股份有限公司"
        .Range("A2").Value = "月度运营数据报告"
        .Range("A3").Value = Date
        .Range("A3").NumberFormat = "YYYY-MM-DD" ' 设置日期格式
        ' 设置A1单元格格式并合并
        With .Range("A1")
            .Font.Bold = True
            .Font.Size = 14
        End With
        With .Range("A1:C1")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        ' 设置A2单元格格式并合并
        With .Range("A2")
            .Font.Bold = True
            .Font.Size = 14
        End With
        With .Range("A2:C2")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
    MsgBox "报告表头已生成完毕", vbInformation
End Sub

3. 在Excel中执行VBA代码

首先，新建模块，有两种方式：

方式一：Excel-开发工具-宏，在弹窗中随便起个名字，点「创建」

方式二：点进去编辑界面-插入-模块

然后在下图的模块中，把原先的内容清空，把AI给的代码黏贴进去

最后在运行-运行子过程，即可！！

4. 运行效果：

1. 执行宏后，当前活动工作表的A1:C3区域将按预设要求自动生成表头内容和格式。

代码说明：

• Sub GenerateReportHeader() 和 End Sub：定义了一个VBA过程（宏）的开始和结束。

• Dim ws As Worksheet：声明一个名为 ws 的变量，其类型为 Worksheet（工作表对象）。

• Set ws = ActiveSheet：将当前活动的工作表对象赋值给变量 ws。

• With ws ... End With：一个便利结构，使得在此代码块内以点 . 开头的属性和方法都默认针对 ws 对象。

• .Range("A1").Value = "文本"：设置指定单元格（如此处的A1）的值。

• .Range("A3").NumberFormat = "YYYY-MM-DD"：设置单元格的数字格式。

• .Font.Bold = True：设置字体为粗体。

• .Font.Size = 14：设置字号大小。

• .Range("A1:C1").Merge：合并指定的单元格区域。

• .HorizontalAlignment = xlCenter：设置内容水平居中。

• MsgBox "提示信息", vbInformation：弹出一个包含指定提示信息的消息框。

觉得它太简单的话，也可以继续用Deepseek帮我们设计一个复杂的版本：

替换原来的模块，或者重新新建一个：

是不是有那味了？

案例2：自动生成带超链接的工作表目录

问题背景：

当一个Excel工作簿中包含大量工作表时（例如，各个月份的销售数据、不同部门的预算表等），手动查找和切换工作表会变得效率低下。

例如我现在一个Excel有多个Sheet，是每个月的销售表。

目标：

利用VBA代码自动创建一个名为"目录"的工作表。该工作表将列出工作簿中所有其他工作表的名称，并为每个名称创建超链接，方便快速跳转。同时，在每个数据工作表特定位置（如E1单元格）添加一个"返回目录"的超链接。

操作步骤：

1. 明确需求，构建AI指令：

    请编写Excel VBA代码实现以下功能：
    1. 检查当前工作簿中是否存在名为"目录"的工作表。
       a. 如果不存在，则在所有工作表的末尾新建一个名为"目录"的工作表。
       b. 如果已存在，则清空该"目录"工作表的所有内容。
    2. 在"目录"工作表的A1单元格写入"序号"，B1单元格写入"工作表名称"，并将这两个单元格字体加粗。
    3. 从第二行开始，在"目录"工作表中生成所有其他工作表的列表：
       a. A列为序号，从1开始递增。
       b. B列为对应工作表的名称。
       c. B列的工作表名称应设置为超链接，点击后跳转到对应工作表的A1单元格。链接文本颜色设置为蓝色。
    4. 遍历工作簿中所有非"目录"的工作表，在每个工作表的E1单元格创建文本为"返回目录"的超链接，点击后跳转到"目录"工作表的A1单元格。此链接文本颜色也设置为蓝色。如果E1单元格已有超链接，先将其删除。
    5. 代码执行开始前关闭屏幕更新，结束后恢复屏幕更新，并显示"目录生成/更新完毕！"的提示信息。
    6. 自动调整"目录"工作表A列和B列的列宽以适应内容。

2. 用DeepSeek v3生成vba代码：

Sub CreateOrUpdateTableOfContents()
    Dim mainWorkbook As Workbook
    Dim tocSheet As Worksheet
    Dim ws As Worksheet
    Dim rowIndex As Long
    Dim sheetCounter As Long
    Application.ScreenUpdating = False
    Set mainWorkbook = ThisWorkbook
    ' 步骤1: 创建或引用"目录"工作表
    On Error Resume Next ' 临时忽略错误，以便检查工作表是否存在
    Set tocSheet = mainWorkbook.Worksheets("目录")
    On Error GoTo 0 ' 恢复正常错误处理
    If tocSheet Is Nothing Then
        Set tocSheet = mainWorkbook.Worksheets.Add(After:=mainWorkbook.Sheets(mainWorkbook.Sheets.Count))
        tocSheet.Name = "目录"
    Else
        tocSheet.Cells.ClearContents ' 如果存在则清空
    End If
    ' 步骤2: 设置"目录"工作表表头
    With tocSheet
        .Range("A1").Value = "序号"
        .Range("B1").Value = "工作表名称"
        .Range("A1:B1").Font.Bold = True
    End With
    rowIndex = 2 ' 目录条目从第二行开始
    sheetCounter = 0
    ' 步骤3: 生成目录列表及超链接
    For Each ws In mainWorkbook.Worksheets
        If ws.Name <> tocSheet.Name Then ' 排除"目录"工作表本身
            sheetCounter = sheetCounter + 1
            With tocSheet
                .Cells(rowIndex, "A").Value = sheetCounter ' 序号
                .Cells(rowIndex, "B").Value = ws.Name      ' 工作表名称
                ' 创建到对应工作表的超链接
                .Hyperlinks.Add Anchor:=.Cells(rowIndex, "B"), _
                                Address:="", _
                                SubAddress:="'" & ws.Name & "'!A1", _
                                TextToDisplay:=ws.Name
                .Cells(rowIndex, "B").Font.Color = vbBlue
            End With
            rowIndex = rowIndex + 1
        End If
    Next ws
    ' 步骤4: 在其他工作表添加"返回目录"链接
    For Each ws In mainWorkbook.Worksheets
        If ws.Name <> tocSheet.Name Then
            On Error Resume Next ' 忽略可能没有超链接的错误
            ws.Range("E1").Hyperlinks.Delete ' 先删除E1可能存在的旧链接
            On Error GoTo 0
            ws.Hyperlinks.Add Anchor:=ws.Range("E1"), _
                              Address:="", _
                              SubAddress:="'" & tocSheet.Name & "'!A1", _
                              TextToDisplay:="返回目录"
            ws.Range("E1").Font.Color = vbBlue
        End If
    Next ws
    ' 步骤6: 自动调整列宽
    tocSheet.Columns("A:B").AutoFit
    Application.ScreenUpdating = True
    ' 步骤5: 完成提示
    MsgBox "目录生成/更新完毕！", vbInformation
End Sub

按案例1的一样操作，直接运行，就能看到目录了。

代码说明：

• Application.ScreenUpdating = False：在宏执行期间关闭屏幕刷新，可以提高执行速度，尤其在操作多个工作表时效果明显。

• On Error Resume Next / On Error GoTo 0：VBA的错误处理语句。On Error Resume Next 使程序在遇到运行时错误时继续执行下一行代码，常用于可预见的、不影响主流程的小错误。On Error GoTo 0 则恢复标准的错误处理机制。

• Worksheets.Add(After:=Sheets(Sheets.Count))：在工作簿的最后一个工作表之后添加一个新的工作表。

• Hyperlinks.Add Anchor:=..., Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=...：添加超链接的核心方法。

  • Anchor: 超链接所依附的单元格对象。
  • Address: 指向外部文件或URL的地址（内部链接时为空字符串）。
  • SubAddress: 指向当前工作簿内部位置的字符串，格式为 '工作表名'!单元格地址。
  • TextToDisplay: 在单元格中显示的超链接文本。

• vbBlue：VBA内置的颜色常量，代表蓝色。

• Columns("A:B").AutoFit：自动调整指定列的宽度以适应其内容。

通过这两个入门案例，可以看出AI在辅助生成VBA代码方面的潜力，使得用户能更专注于需求本身，而非繁琐的语法细节。

案例3：进阶 ------ 复杂数据整合与查询

在处理来自不同数据源或结构复杂的数据时，往往需要进行数据整合与转换。本案例将利用提供的多份CSV数据文件，模拟一个常见的数据处理场景：将事实表数据与维度表数据关联，生成一个包含更丰富信息的新表。此操作若手动使用Excel公式（如VLOOKUP）处理大量数据，效率较低且易出错。

假设我现在有多张表格，如下图，分别是区域表、用户表、产品表、订单表。

其中订单表是这样的：

可以看到，用户和产品都是没名字的，我的需求是让订单表从用户表、产品表上把对应的名字匹配上。

这也是很经典的需求：多表匹配。

请编写一段Excel VBA代码，用于从指定文件夹中的多个Excel文件 (.xlsx) 整合数据到当前活动工作簿的新工作表中。
具体需求如下：
选择源文件夹：
程序开始时，弹出一个对话框让用户选择包含源Excel文件的文件夹。
如果用户未选择文件夹，则中止程序并提示。
定义源文件名：
事实数据文件名: "Model-FactSales.xlsx"
产品维度数据文件名: "Model-DimProduct.xlsx"
客户维度数据文件名: "Model-DimCustomer.xlsx"
城市维度数据文件名: "Model-DimCity.xlsx"
数据关联与填充：

AI生成的VBA代码还是很全面的：包含了文件夹选择、外部文件读取、字典应用和错误处理等要素：

Option Explicit ' 强制声明所有变量

Sub ConsolidateDataFromExternalFiles_V3()
    Dim startTime As Double
    startTime = Timer

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim folderPath As String
    Dim wbSource As Workbook, wbDim As Workbook
    Dim wsSource As Worksheet, wsDim As Worksheet
    Dim wsConsolidated As Worksheet
    Dim dictProducts As Object, dictCustomers As Object, dictCities As Object
    
    Dim factSalesFileName As String, productDimFileName As String, customerDimFileName As String, cityDimFileName As String
    
    Dim arrFactSalesData As Variant ' 用于存储FactSales的原始数据
    Dim arrOutputData As Variant    ' 用于构建最终的输出数据
    
    Dim i As Long, j As Long
    Dim lastRowFact As Long, lastColFact As Long
    Dim lastRowOutput As Long, lastColOutput As Long
    
    ' --- 用于存储在FactSales表中关键Key列的列号 ---
    Dim spuColFact As Long
    Dim customerIdColFact As Long
    Dim cityIdColFact As Long
    
    ' --- 用于存储在Output数组中新增Name列的列号 ---
    Dim productNameColOutput As Long
    Dim customerNameColOutput As Long
    Dim cityNameColOutput As Long
    
    Dim tempKey As Variant

    ' --- 1. 选择源文件夹 ---
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择包含源Excel文件的文件夹"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "未选择文件夹，操作中止。", vbExclamation
            GoTo CleanUpAndExit
        End If
        folderPath = .SelectedItems(1)
        If Right(folderPath, 1) <> Application.PathSeparator Then
            folderPath = folderPath & Application.PathSeparator
        End If
    End With

    ' --- 2. 定义源文件名 ---
    factSalesFileName = "Model-FactSales.xlsx"
    productDimFileName = "Model-DimProduct.xlsx"
    customerDimFileName = "Model-DimCustomer.xlsx"
    cityDimFileName = "Model-DimCity.xlsx"

    ' --- 3.1 创建或重置 "ConsolidatedSales" 工作表 ---
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("ConsolidatedSales").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set wsConsolidated = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsConsolidated.Name = "ConsolidatedSales"

    ' --- 读取 "Model-FactSales.xlsx" 数据到数组 ---
    If Len(Dir(folderPath & factSalesFileName)) = 0 Then
        MsgBox "文件 " & factSalesFileName & " 在指定文件夹中未找到！操作中止。", vbCritical
        GoTo CleanUpAndExit
    End If
    
    On Error GoTo FileOpenErrorFactSales
    Set wbSource = Workbooks.Open(folderPath & factSalesFileName, ReadOnly:=True, UpdateLinks:=0)
    Set wsSource = wbSource.Sheets(1)
    arrFactSalesData = wsSource.UsedRange.Value ' 将整个UsedRange读入数组
    wbSource.Close SaveChanges:=False
    Set wsSource = Nothing
    Set wbSource = Nothing
    On Error GoTo 0
    
    If Not IsArray(arrFactSalesData) Then
        MsgBox "无法从 " & factSalesFileName & " 读取数据。", vbCritical
        GoTo CleanUpAndExit
    End If
    If UBound(arrFactSalesData, 1) < 1 Then ' 至少要有表头行
        MsgBox factSalesFileName & " 为空或格式不正确。", vbCritical
        GoTo CleanUpAndExit
    End If

    ' --- 确定FactSales中关键Key列的列号 (基于表头名称) ---
    For j = LBound(arrFactSalesData, 2) To UBound(arrFactSalesData, 2)
        Select Case Trim(CStr(arrFactSalesData(1, j))) ' 表头在数组的第一行
            Case "SPU": spuColFact = j
            Case "客户ID": customerIdColFact = j
            Case "区域ID": cityIdColFact = j
        End Select
    Next j

    If spuColFact = 0 Or customerIdColFact = 0 Or cityIdColFact = 0 Then
        MsgBox "错误：" & factSalesFileName & " 中未能找到一个或多个关键表头 (SPU, 客户ID, 区域ID)。请检查表头是否正确。", vbCritical
        GoTo CleanUpAndExit
    End If

    ' --- 4. 加载维度表数据到字典 ---
    Set dictProducts = CreateObject("Scripting.Dictionary")
    Set dictCustomers = CreateObject("Scripting.Dictionary")
    Set dictCities = CreateObject("Scripting.Dictionary")

    ' 假设维度文件中的Key在第1列，Name在第2列。如果不是，请修改LoadDictionary_V3的调用参数。
    LoadDictionary_V3 dictProducts, folderPath, productDimFileName, 1, 2 ' keyCol=1 (SPU), valCol=2 (ProductName)
    LoadDictionary_V3 dictCustomers, folderPath, customerDimFileName, 1, 2 ' keyCol=1 (客户ID), valCol=2 (CustomerName)
    LoadDictionary_V3 dictCities, folderPath, cityDimFileName, 1, 2       ' keyCol=1 (区域ID), valCol=2 (CityName)
    
    ' --- 5. 准备输出数组并填充数据 ---
    lastRowFact = UBound(arrFactSalesData, 1)
    lastColFact = UBound(arrFactSalesData, 2)
    
    lastColOutput = lastColFact + 3 ' 新增3列
    productNameColOutput = lastColFact + 1
    customerNameColOutput = lastColFact + 2
    cityNameColOutput = lastColFact + 3
    
    ReDim arrOutputData(LBound(arrFactSalesData, 1) To lastRowFact, LBound(arrFactSalesData, 2) To lastColOutput)

    ' 填充表头行到输出数组
    For j = LBound(arrFactSalesData, 2) To lastColFact
        arrOutputData(LBound(arrFactSalesData, 1), j) = arrFactSalesData(LBound(arrFactSalesData, 1), j)
    Next j
    arrOutputData(LBound(arrFactSalesData, 1), productNameColOutput) = "ProductName" ' 或中文 "产品名称"
    arrOutputData(LBound(arrFactSalesData, 1), customerNameColOutput) = "CustomerName" ' 或中文 "客户名称"
    arrOutputData(LBound(arrFactSalesData, 1), cityNameColOutput) = "CityName"     ' 或中文 "区域名称"

    ' 填充数据行
    For i = LBound(arrFactSalesData, 1) + 1 To lastRowFact ' 从第二行开始 (数据行)
        ' 复制原始数据
        For j = LBound(arrFactSalesData, 2) To lastColFact
            arrOutputData(i, j) = arrFactSalesData(i, j)
        Next j
        
        ' 查找并填充ProductName
        tempKey = arrFactSalesData(i, spuColFact)
        If Not IsEmpty(tempKey) And dictProducts.Exists(CStr(tempKey)) Then
            arrOutputData(i, productNameColOutput) = dictProducts(CStr(tempKey))
        Else
            arrOutputData(i, productNameColOutput) = "N/A"
        End If
        
        ' 查找并填充CustomerName
        tempKey = arrFactSalesData(i, customerIdColFact)
        If Not IsEmpty(tempKey) And dictCustomers.Exists(CStr(tempKey)) Then
            arrOutputData(i, customerNameColOutput) = dictCustomers(CStr(tempKey))
        Else
            arrOutputData(i, customerNameColOutput) = "N/A"
        End If
        
        ' 查找并填充CityName
        tempKey = arrFactSalesData(i, cityIdColFact)
        If Not IsEmpty(tempKey) And dictCities.Exists(CStr(tempKey)) Then
            arrOutputData(i, cityNameColOutput) = dictCities(CStr(tempKey))
        Else
            arrOutputData(i, cityNameColOutput) = "N/A"
        End If
    Next i
    
    ' --- 6. 将输出数组写入 "ConsolidatedSales" 工作表 ---
    wsConsolidated.Range("A1").Resize(UBound(arrOutputData, 1), UBound(arrOutputData, 2)).Value = arrOutputData
    wsConsolidated.UsedRange.Columns.AutoFit

CleanUpAndExit:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Set wbSource = Nothing
    Set wsSource = Nothing
    Set wsDim = Nothing
    Set wsConsolidated = Nothing
    Set dictProducts = Nothing
    Set dictCustomers = Nothing
    Set dictCities = Nothing
    If IsArray(arrFactSalesData) Then Erase arrFactSalesData
    If IsArray(arrOutputData) Then Erase arrOutputData

    If Err.Number = 0 And folderPath <> "" And spuColFact > 0 And customerIdColFact > 0 And cityIdColFact > 0 Then
         MsgBox "数据整合完成！用时: " & Format(Timer - startTime, "0.00") & " 秒", vbInformation
    ElseIf Err.Number <> 0 Then
        MsgBox "操作过程中发生错误 (代码: " & Err.Number & "): " & Err.Description, vbCritical
    End If
    Err.Clear
    Exit Sub

FileOpenErrorFactSales:
    MsgBox "打开文件时发生错误: " & folderPath & factSalesFileName & vbCrLf & "错误描述: " & Err.Description, vbCritical
    Err.Clear
    GoTo CleanUpAndExit
End Sub

' 辅助函数：从外部文件加载字典数据 (V3)
Sub LoadDictionary_V3(dict As Object, ByVal filePath As String, ByVal fileName As String, ByVal keyColNum As Long, ByVal valColNum As Long)
    Dim wbDim As Workbook
    Dim wsDim As Worksheet
    Dim arrDim As Variant
    Dim r As Long, lastRowDim As Long
    
    If Len(Dir(filePath & fileName)) = 0 Then
        MsgBox "维度文件 " & fileName & " 在指定文件夹中未找到！对应字典将为空。", vbExclamation
        Exit Sub
    End If
    
    On Error GoTo LoadDictError_V3
    Set wbDim = Workbooks.Open(filePath & fileName, ReadOnly:=True, UpdateLinks:=0)
    Set wsDim = wbDim.Sheets(1) ' 始终假设数据在第一个工作表
    
    lastRowDim = wsDim.Cells(wsDim.Rows.Count, keyColNum).End(xlUp).Row
    
    If lastRowDim > 1 Then ' 至少要有数据行 (除了表头)
        ' 确保读取的数组范围至少包含keyColNum和valColNum
        Dim firstColToRead As Long, lastColToRead As Long
        firstColToRead = Application.Min(keyColNum, valColNum)
        lastColToRead = Application.Max(keyColNum, valColNum)
        
        arrDim = wsDim.Range(wsDim.Cells(2, firstColToRead), wsDim.Cells(lastRowDim, lastColToRead)).Value
        
        Dim actualKeyColInArray As Long, actualValColInArray As Long
        actualKeyColInArray = keyColNum - firstColToRead + 1
        actualValColInArray = valColNum - firstColToRead + 1
        
        If IsArray(arrDim) Then
             For r = LBound(arrDim, 1) To UBound(arrDim, 1)
                If Not IsEmpty(arrDim(r, actualKeyColInArray)) Then
                    If Not dict.Exists(CStr(arrDim(r, actualKeyColInArray))) Then
                        dict.Add CStr(arrDim(r, actualKeyColInArray)), arrDim(r, actualValColInArray)
                    End If
                End If
            Next r
        Else ' 处理只读取到单行数据，Range返回非数组的情况
            If lastRowDim = 2 And Not IsEmpty(arrDim) Then ' 特殊处理只有一行数据的情况
                 If Not IsEmpty(wsDim.Cells(2,keyColNum).Value) Then
                    If Not dict.Exists(CStr(wsDim.Cells(2,keyColNum).Value)) Then
                        dict.Add CStr(wsDim.Cells(2,keyColNum).Value), wsDim.Cells(2,valColNum).Value
                    End If
                 End If
            End If
        End If
    End If
    
    wbDim.Close SaveChanges:=False
    Set wsDim = Nothing
    Set wbDim = Nothing
    Exit Sub

LoadDictError_V3:
    MsgBox "加载字典时打开或读取文件 " & filePath & fileName & " 失败。" & vbCrLf & "错误 (代码: " & Err.Number & "): " & Err.Description, vbExclamation
    If Not wbDim Is Nothing Then wbDim.Close SaveChanges:=False
    Set wsDim = Nothing
    Set wbDim = Nothing
    Err.Clear
End Sub

运行后，会弹出一个选择文件夹的框，让我们选中包含多个数据表的文件夹：

选择后，运行，7s时间就帮我把表格的多个列匹配上了。

在实践的过程中容易遇到3个坑：

• VBA是大小写敏感的，例如我这个案例中，一开始跑不通后来我猜是这个问题，改成小写才行

• 不同电脑上，甚至不同Office的配置可能会影响vba，例如我一开始是在windows上用的VBA，挪到MAC上就不能用了，所以有时候不是代码问题，而是环境本身。

最后就是提示词的问题，因为涉及业务逻辑，或者表格描述，其实是要写精准了，最后给的VBA代码才能正确运行。我的解决方案是让AI去写提示词就好了，包括这几个案例，提示词这么标准的描述要做的动作，是因为我让DeepSeek给了多个提示词我选，然后我选择符合我预期的来调整即可！

对于表格涉及的，也可以直接给图，但DeepSeek不支持多模态，可以给到Gemini或者Claude，也是不错的选择。

以上就是今天分享的全部内容，如果对你有所帮助，还请点【关注】支持。