专栏名称: 完美Excel
Excel与VBA技术学习与实践
目录
相关文章推荐
Excel之家ExcelHome  ·  WPS表格中的几个实用功能 ·  2 天前  
Excel之家ExcelHome  ·  让Excel自动检测录入的数据 ·  昨天  
Excel之家ExcelHome  ·  还在手动筛选数据?FILTER函数这几种典型 ... ·  昨天  
完美Excel  ·  使用deepseek自动合并“复杂的”Exc ... ·  5 天前  
完美Excel  ·  deepseep+Python实现自动合并E ... ·  3 天前  
51好读  ›  专栏  ›  完美Excel

使用deepseek自动合并“复杂的”Excel工作簿

完美Excel  · 公众号  · Excel  · 2025-02-15 06:59

正文

学习Excel技术,关注微信公众号:
excelperfect

标签: AI 大模型 deepseek VBA

使用 deepseek 自动合并工作簿 中,工作簿结构相对较简单,都是工作表上第 1 行为标题行,其余行为数据,很方便使用代码实现。然而,如果要合并的工作簿中的工作表是我们经常要填写的“简历表”“检查表”等表格样式的数据, deepseek 仍然能够给出满足需求的代码吗?

如下图 1 所示,是一份空表,在工作簿 InfoTable.xlsx 中。可以看到,已经尽量少使用合并单元格,但仍然有很多合并单元格(这往往是给代码带来问题或复杂性的地方)。

1
下图 2 和图 3 是填写好的两份表,分别在工作簿 InfoTable1.xlsx InfoTable2.xlsx 中。

2
3
这些工作簿都放置在同一文件夹中,如下图 4 所示。

4
在分析了工作簿结构和需求后,我向 deepseek 提问:

我需要汇总多个工作簿。具体情况如下:

1. 这些工作簿都位于同一文件夹中。

2. 这些工作簿只包含一个工作表。

3. 工作表模版如附件工作簿 InfoTable.xlsx 中的 委托单 工作表,数据区域为单元格区域 B7:I16

4. 新建一个工作簿中用于汇总数据,其标题行为模版 委托单 工作表 B7:I16 中空单元格左侧单元格内容,其数据为委托单 工作表 B7:I16 中空单元格输入的内容。

5. 附件有两个示例数据工作簿 InfoTable1.xlsx InfoTable2.xlsx

请帮我编写 VBA 代码。

同时,上传了这 3 个工作簿作为附件。提问及上传的附件如下图 5 所示。

5
经过详细的需求理解分析和思考后, deepseek 给出的代码如下:

Sub 汇总委托单数据() Dim wsTemplate As Worksheet Dim wsSummary As Worksheet Dim wbSummary As Workbook Dim dictHeaders As Object Dim arrHeaders() Dim lastRow As Long Dim folderPath As String Dim filePattern As String Dim templateFile As String Dim fileName As String Dim cell As Range Dim headerIndex As Integer Dim i As Integer, j As Integer
' 初始化设置 Set dictHeaders = CreateObject("Scripting.Dictionary") templateFile = "InfoTable.xlsx"  ' 模板文件名 filePattern = "*.xlsx" ' 文件筛选模式 folderPath = ThisWorkbook.Path & "\"  ' 假设代码运行在目标文件夹中
' 步骤1:解析模板文件获取标题 Application.ScreenUpdating = False Workbooks.Open folderPath & templateFile Set wsTemplate = Workbooks(templateFile).Sheets("委托单")
' 遍历模板B7:I16区域建立标题字典 headerIndex = 0 For Each cell In wsTemplate.Range("B7:I16") If cell.Value = "" Then ' 跳过空列(即左侧单元格也为空的情况)     If cell.Offset(0, -1).Value <> "" Then       If Not dictHeaders.Exists(cell.Offset(0, -1).Value) Then         dictHeaders.Add cell.Offset(0, -1).Value, headerIndex         ReDim Preserve arrHeaders(headerIndex)         arrHeaders(headerIndex) = cell.Offset(0, -1).Value         headerIndex = headerIndex + 1 End If End If End If Next cell
' 步骤2:创建汇总工作簿 Set wbSummary = Workbooks.Add Set wsSummary = wbSummary.Sheets(1) wsSummary.Name = "汇总数据"
' 写入标题行 For i = 0 To UBound(arrHeaders)   wsSummary.Cells(1, i + 1).Value = arrHeaders(i) Next i
' 步骤3:遍历文件夹处理数据文件 fileName = Dir(folderPath & filePattern) lastRow = 1
Do While fileName <> ""   If fileName <> templateFile And fileName <> wbSummary.Name Then Dim wbSource As Workbook     Set wbSource = Workbooks.Open(folderPath & fileName)
Dim wsSource As Worksheet     Set wsSource = wbSource.Sheets("委托单")
lastRow = lastRow + 1 Dim dataIndex As Integer
' 遍历模板标记的空单元格位置提取数据     For Each cell In wsTemplate.Range("B7:I16")       If cell.Value = "" Then '






请到「今天看啥」查看全文