我要投稿

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

发布日期：2025-02-21 18:37:53 浏览次数： 1544 来源：完美Excel

学习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) = filteredData(i)(headerDict("单位内编号"))     .Cells(targetRow, 4) = filteredData(i)(headerDict("载重量（kg）"))     .Cells(targetRow, 5) = filteredData(i)(headerDict("层站数"))     .Cells(targetRow, 6) = filteredData(i)(headerDict("速度（m/s）"))     .Cells(targetRow, 7) = filteredData(i)(headerDict("检测时间"))     .Cells(targetRow, 8) = filteredData(i)(headerDict("费用"))   End With   targetRow = targetRow + 1 Next i  ' ===== 处理符合性声明===== srcWb.Sheets("符合性声明").Copy After:=destWb.Sheets(destWb.Sheets.Count) Set newWs = destWb.ActiveSheet newWs.Name = "符合性声明"
 ' 设备代码特殊处理（A列） targetRow = 7 For i = 1 To filteredData.Count   With newWs     .Cells(targetRow, 1).NumberFormat = "@"     .Cells(targetRow, 1).Value = "'" & CStr(filteredData(i)(headerDict("设备代码")))     .Cells(targetRow, 2) = filteredData(i)(headerDict("产品编号"))     .Cells(targetRow, 3) = filteredData(i)(headerDict("登记证编号"))     .Cells(targetRow, 4) = filteredData(i)(headerDict("单位内编号"))   End With   targetRow = targetRow + 1 Next i
 ' 删除默认Sheet1（如果存在） On Error Resume Next Application.DisplayAlerts = False destWb.Sheets("Sheet1").Delete Application.DisplayAlerts = True On Error GoTo 0
 ' 保存 destWb.SaveAs "Generated_Report.xlsx" MsgBox "处理完成！", vbInformationEnd Sub