完全使用deepseek自动填写多个Excel工作表

完美Excel · 公众号 · Excel · 2025-02-13 12:22

正文

学习Excel技术，关注微信公众号：

excelperfect

标签： AI ，大模型， deepseek ， VBA

在使用 deepseek 自动填写 Excel 工作表信息中，我们让 deepseek 给出了根据汇总信息填写模版工作表的 VBA 代码。下面，我们试试 deepseek 能不能实现更复杂的 VBA 程序。工作簿中有 4 个工作表，其中 1 个是信息汇总工作表，用于提取信息；有 3 个作为模版工作表，用于填写，且其中 1 个需根据查找的特定项的条目数生成多个工作表，另外 2 个直接在其上填写查找到的相关信息，有多少条就填写多少条。具体如下图 1 至图 4 所示。

下图 1 为“信息总表”，汇总了所有信息。后面要根据指定的“使用单位名称”查找相应的信息。

图 1

下图 2 为作为模版的“委托单”工作表，根据查找的“使用单位名称”填写，查找到多少条信息就要填写多少个“委托单”工作表。

图 2

下图 3 为作为模版的“附表”工作表，根据查找的“使用单位名称”填写，查找到多少条信息，自第 5 行起就填写多少条对应的信息数据。

图 3

下图 4 为作为模版的“符合性声明”工作表，根据查找的“使用单位名称”填写，查找到多少条信息，自第 6 行起就填写多少条对应的信息数据。

图 4

理清楚需求后，就可以开始向 deepseek 提问了。

下面是向 deepseek 的提问：

附件中有一个包含 4 个工作表的工作簿，工作表 “ 信息总表 ” 中包含一系列数据，工作表 “ 委托单 ” 、 " 附表 " 、 “ 符合性声明 ” 都是一个模版。我想新建一个工作簿，其工作表以 “ 委托单 ” 、 " 附表 " 、 “ 符合性声明 ” 为模版，然后在原工作簿的 “ 信息总表 ” 的列 A 中查找特定的使用单位，根据查找到的使用单位在刚才新建的工作簿中创建新工作表，例如查找 “ 完美生活服务集团股份有限公司 ” 有 2 条，则在新工作簿中以 “ 委托单 ” 、 " 附表 " 、 “ 符合性声明 ” 为模版分别创建工作表，并将相关行信息分别填入这些工作表中带有 “ 自动获取 ” 字样的单元格中，其中，因为查找到 2 条 “ 完美生活服务集团股份有限公司 ” 记录，所以 " 委托单 " 工作表要创建 2 个，且其中 “ 自动获取 ” 字样的单元格中填入的数据为其左侧单元格中的数据在 “ 信息总表 ” 中查找的结果； " 附表 " 工作表中以第 4 行为基础在 “ 信息总表 ” 中查找对应行的结果，并将结果填充到第 5 行开始的单元格中； “ 符合性声明 ” 工作表中单元格 C4 填写以其左侧单元格中的数据在 “ 信息总表 ” 中查找的结果，同时以第 6 行为基础在 “ 信息总表 ” 中查找对应行的结果，并将结果填充到第 7 行开始的单元格中。请帮我使用 VBA 实现。

同时，上传示例工作簿作为附件供 deepseek 分析。

deepseek 的思路很清晰，并给出了完整的代码，但经过运行，发现有两处错误。于是，接着向 deepseek 提问：

上述代码运行时，发生了两处错误： 1.Application.SheetsInNewWorkbook = 0 发生错误； 2.cell.Value = filteredData(i)(colIndex) 发生 “ 类型不匹配 ” 错误

deepseek 分析了错误原因并进行了修正，但在代码运行时还是发现有一处新错误。接着向 deepseek 提问：

上述代码中的 newWs.Range("H" & .Rows.Count).End(xlUp).Offset(1).Value = detecDate 这句中的 .Rows.Count 为无效引用，请修改

这次给出的代码基本比较完整了，但出现了一个小小的数据输入转换问题。再次向 deepseek 提问：

上述代码会将复制后的“设备代码”变成科学计数法，请修正

deepseek 解决了这个问题。

最后，经过我稍作调整的完整代码如下：

Sub GenerateNewWorkbook() Dim srcWb As Workbook, destWb As Workbook Dim infoSheet As Worksheet, tempSheet As Worksheet Dim criteria As String, lastRow As Long, i As Long, j As Long Dim headerDict As Object, dataArr As Variant, filteredData As Collection Dim ws As Worksheet, newWs As Worksheet, cell As Range Dim fieldName As String, colIndex As Long, targetRow As Long Dim rowData() As Variant
 Set srcWb = ThisWorkbook Set infoSheet = srcWb.Sheets("信息总表") criteria = InputBox("请输入需要筛选的使用单位名称：")
 ' 获取信息总表数据 lastRow = infoSheet.Cells(infoSheet.Rows.Count, "A").End(xlUp).row dataArr = infoSheet.Range("A1:V" & lastRow).Value
 ' 创建标题字典 Set headerDict = CreateObject("Scripting.Dictionary") For j = 1 To UBound(dataArr, 2)   headerDict(Trim(dataArr(1, j))) = j Next j
 ' 筛选目标数据（存储整行数据） Set filteredData = New Collection For i = 2 To UBound(dataArr, 1)   If dataArr(i, headerDict("使用单位名称")) = criteria Then     ReDim rowData(1 To UBound(dataArr, 2))     For j = 1 To UBound(dataArr, 2)       rowData(j) = dataArr(i, j)     Next j     filteredData.Add rowData   End If Next i
 If filteredData.Count = 0 Then Exit Sub
 ' 创建新工作簿（不再设置SheetsInNewWorkbook） Set destWb = Workbooks.Add
 ' ===== 处理委托单 ===== For i = 1 To filteredData.Count   srcWb.Sheets("委托单").Copy After:=destWb.Sheets(destWb.Sheets.Count)   Set newWs = destWb.ActiveSheet   newWs.Name = "委托单_" & i
   ' 替换自动获取内容（新增设备代码格式处理）   For Each cell In newWs.UsedRange     If InStr(cell.Value, "自动获取") > 0 Then       fieldName = Split(cell.Value, "自动获取")(1)       fieldName = Trim(fieldName)       If headerDict.Exists(fieldName) Then         colIndex = headerDict(fieldName)         cell.NumberFormat = "@" ' 强制设为文本格式         cell.Value = CStr(filteredData(i)(colIndex)) ' 转换为字符串
         ' 特殊处理设备代码（保留完整数字）         If fieldName = "设备代码" Then           cell.Value = "'" & CStr(filteredData(i)(colIndex)) ' 添加单引号保留格式         End If       End If     End If   Next cell
   ' 处理拟检测日期（修正无效引用）   On Error Resume Next   Dim detecDate As Date   ' 提取检测时间并去除时间部分（如存在）   Dim rawDate As String   rawDate = filteredData(i)(headerDict("检测时间"))   If InStr(rawDate, " ") > 0 Then     rawDate = Split(rawDate, "")(0) ' 仅保留日期部分   End If   detecDate = DateAdd("m", -1, CDate(rawDate))
   ' 找到H列最后一个非空单元格的下方插入新日期   With newWs     Dim lastRowH As Long     lastRowH = .Cells(.Rows.Count, "H").End(xlUp).row     .Cells(lastRowH + 1, "H").Value = Format(detecDate, "yyyy-mm-dd")   End With   On Error GoTo 0 Next i
 ' ===== 处理附表 ===== srcWb.Sheets("附表").Copy After:=destWb.Sheets(destWb.Sheets.Count) Set newWs = destWb.ActiveSheet newWs.Name = "附表" targetRow = 5
 For i = 1 To filteredData.Count   With newWs     ' 设备代码特殊处理（C列）     .Cells(targetRow, 3).NumberFormat = "@"     .Cells(targetRow, 3).Value = "'" & CStr(filteredData(i)(headerDict("设备代码")))
     ' 其他字段正常写入     .Cells(targetRow, 1) = i     .Cells(targetRow, 2

完全使用deepseek自动填写多个Excel工作表

正文

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