使用deepseek自动填写Excel工作表信息

最新推荐文章于 2025-03-02 22:17:23 发布

程序猿李巡天

最新推荐文章于 2025-03-02 22:17:23 发布

阅读量1.1k

点赞数 21

文章标签： excel 人工智能计算机视觉网络学习机器学习

本文链接：https://blog.csdn.net/m0_59235945/article/details/145616520

版权

前天收到一位网友的求助，大致意思是：需要经常从一个大的excel信息汇总表中获取到数据，然后生成几个固定的格式的表单，希望使用VBA实现查找特定使用单位名称后，能够自动获取并在表单中填写对应的信息。

具体如下（我将示例数据进行了修改，应该不会侵犯那位朋友的隐私。若有，请给我留言，我将立即删除）：

如下图1所示的“信息总表”工作表中，汇总有完整的数据。

图1

下图2为固定格式的表单。

图2

我理解他的意图是，从“信息总表”中提取数据自动填写到“委托单”中带有“自动获取”字样的单元格，且有多少条数据就填写多少个委托单。考虑到其需求，我想自动生成一个新工作簿，包含所查找的特定数据的所有“委托单”。

刚开始，我认为deepseek应该不大可能会处理这样的问题，于是自己编写了一段VBA代码来实现。但是，我还是太低估了deepseek的能力！

昨天晚上，我还是想让deepseek试试，看它能否完成这样的需求。

经过几次试提问题答复不满意后，我再一次修正，向deepseek提问如下：

附件中有一个包含两个工作表的工作簿，工作表“信息总表”中包含一系列数据，工作表“委托单”是一个模版。我想新建一个工作簿，其工作表以“委托单”为模版，然后在原工作簿的“信息总表”的列A中查找特定的使用单位，查找到多少条使用单位就在刚才新建的工作簿中创建几个工作表，例如查找“完美生活服务集团股份有限公司”有2条，则在新工作簿中以“委托单”为模版创建2个工作表，并将相关行信息分别填入这些工作表中带有 “自动获取”字样的单元格中，“自动获取”字样的单元格中填入的数据为其左侧单元格中的数据在“信息总表”中查找的结果。请帮我使用VBA实现。

同时，我上传示例工作簿作为附件。

deepseek给出了它的思考过程，比较符合我的意图。同时，给出的代码如下：

Sub GenerateCommissionSheets()` `Dim srcWB As Workbook, newWB As Workbook` `Dim infoSheet As Worksheet, templateSheet As Worksheet` `Dim criteria As String, lastRow As Long, i As Long` `Dim matchedRows As New Collection` `Dim headerRow As Range, targetSheet As Worksheet` `Dim cell As Range, leftCell As Range, colIndex As Variant``   ` `Set srcWB = ThisWorkbook ' 假设代码在当前工作簿运行` `Set infoSheet = srcWB.Sheets("信息总表")` `Set templateSheet = srcWB.Sheets("委托单")``   ` `' 获取用户输入的使用单位` `criteria = InputBox("请输入要筛选的使用单位名称：", "输入筛选条件")` `If criteria = "" Then Exit Sub``   ` `' 在信息总表中查找匹配行` `With infoSheet`   `lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row`   `For i = 2 To lastRow ' 假设第1行为标题行`     `If .Cells(i, 1).Value = criteria Then matchedRows.Add i`   `Next i` `End With``   ` `If matchedRows.Count = 0 Then`   `MsgBox "未找到匹配的使用单位记录。", vbInformation`   `Exit Sub` `End If``   ` `' 创建新工作簿` `Set newWB = Workbooks.Add` `Application.DisplayAlerts = False` `While newWB.Sheets.Count > 1`   `newWB.Sheets(1).Delete` `Wend` `Application.DisplayAlerts = True``   ` `' 为每个匹配行创建委托单` `For Each Item In matchedRows`   `templateSheet.Copy Before:=newWB.Sheets(1)`   `Set targetSheet = newWB.Sheets(1)`   `With targetSheet`     `.Name = "委托单" & newWB.Sheets.Count`     `' 查找所有自动获取单元格`     `For Each cell In .UsedRange`       `If cell.Value Like "*自动获取*" Then`         `Set leftCell = cell.Offset(0, -1)`         `colIndex = Application.Match(leftCell.Value, infoSheet.Rows(1), 0)``   `         `If Not IsError(colIndex) Then`           `cell.Value = infoSheet.Cells(Item, colIndex).Value`         `Else`           `cell.Value = "数据未找到"`         `End If`       `End If`     `Next cell`   `End With` `Next Item``   ` `' 删除初始空白表并整理工作簿` `newWB.Sheets(1).Delete` `newWB.Sheets(1).Activate` `newWB.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\" & criteria & "委托单.xlsx"` `MsgBox "已生成 " & matchedRows.Count & " 张委托单！", vbInformation``End Sub

很好！基本实现了我的意图。但是有两点小瑕疵：

1.Item变量未定义。

2.newWB.Sheets(1).Delete不是删除在新建工作簿时自带的空工作表，而是将新添加的填写了信息的工作表给删除了。

我对其进行了调整后，代码实现了我需要的功能。我修改后的代码如下：

Sub GenerateCommissionSheetsPlus()` `Dim srcWB As Workbook, newWB As Workbook` `Dim infoSheet As Worksheet, templateSheet As Worksheet` `Dim criteria As String, lastRow As Long, i As Long` `Dim matchedRows As New Collection` `Dim Item As Variant` `Dim headerRow As Range, targetSheet As Worksheet` `Dim cell As Range, leftCell As Range, colIndex As Variant``   ` `Set srcWB = ThisWorkbook ' 假设代码在当前工作簿运行` `Set infoSheet = srcWB.Sheets("信息总表")` `Set templateSheet = srcWB.Sheets("委托单")``   ` `' 获取用户输入的使用单位` `criteria = InputBox("请输入要筛选的使用单位名称：", "输入筛选条件")` `If criteria = "" Then Exit Sub``   ` `' 在信息总表中查找匹配行` `With infoSheet`   `lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row`   `For i = 2 To lastRow ' 假设第1行为标题行`     `If .Cells(i, 1).Value = criteria Then matchedRows.Add i`   `Next i` `End With``   ` `If matchedRows.Count = 0 Then`   `MsgBox "未找到匹配的使用单位记录。", vbInformation`   `Exit Sub` `End If``   ` `' 创建新工作簿` `Set newWB = Workbooks.Add` `Application.DisplayAlerts = False` `While newWB.Sheets.Count > 1`   `newWB.Sheets(1).Delete` `Wend` `Application.DisplayAlerts = True``   ` `' 为每个匹配行创建委托单` `For Each Item In matchedRows`   `templateSheet.Copy after:=newWB.Sheets(Worksheets.Count)`   `Set targetSheet = newWB.Sheets(Worksheets.Count)`   `With targetSheet`     `.Name = "委托单" & newWB.Sheets.Count - 1`     `' 查找所有自动获取单元格`     `For Each cell In .UsedRange`       `If cell.Value Like "*自动获取*" Then`         `Set leftCell = cell.Offset(0, -1)`         `colIndex = Application.Match(leftCell.Value, infoSheet.Rows(1), 0)``   `         `If Not IsError(colIndex) Then`           `cell.Value = infoSheet.Cells(Item, colIndex).Value`         `Else`           `cell.Value = "数据未找到"`         `End If`       `End If`     `Next cell`   `End With` `Next Item``   ` `' 删除初始空白表并整理工作簿` `newWB.Sheets(1).Delete` `newWB.Sheets(1).Activate` `newWB.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\" & criteria & "委托单.xlsx"` `MsgBox "已生成 " & matchedRows.Count & " 张委托单！", vbInformation``End Sub

运行后的结果如下图3所示。生成了一个包含所查找的数据的所有委托单的工作簿，并自动填写了相应的信息。

图3

但我并没有结束，我想看看deepseek是怎么修改的。于是，我接着向它提问：

上述代码调试时显示Item变量未定义，请帮我修改

deepseek仔细检查了代码并进行了修正和优化。这次给出的代码如下：

Sub GenerateCommissionSheets()` `Dim srcWB As Workbook, newWB As Workbook` `Dim infoSheet As Worksheet, templateSheet As Worksheet` `Dim criteria As String, lastRow As Long, i As Long` `Dim matchedRows As New Collection` `Dim headerRow As Range, targetSheet As Worksheet` `Dim cell As Range, leftCell As Range, colIndex As Variant` `Dim rowNum As Variant ' 声明循环变量``   ` `Set srcWB = ThisWorkbook` `Set infoSheet = srcWB.Sheets("信息总表")` `Set templateSheet = srcWB.Sheets("委托单")``   ` `criteria = InputBox("请输入要筛选的使用单位名称：", "输入筛选条件")` `If criteria = "" Then Exit Sub``   ` `' 查找匹配行（优化空值处理）` `With infoSheet`   `lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row`   `For i = 2 To lastRow`     `If Trim(.Cells(i, 1).Value) = criteria Then`        `matchedRows.Add i`     `End If`   `Next i` `End With``   ` `If matchedRows.Count = 0 Then`   `MsgBox "未找到匹配的使用单位记录。", vbInformation`   `Exit Sub` `End If``   ` `' 创建新工作簿（增加错误处理）` `On Error Resume Next` `Set newWB = Workbooks.Add` `Application.DisplayAlerts = False` `Do While newWB.Sheets.Count > 1`   `newWB.Sheets(1).Delete` `Loop` `Application.DisplayAlerts = True``   ` `' 生成委托单（优化命名逻辑）` `For Each rowNum In matchedRows`   `templateSheet.Copy Before:=newWB.Sheets(1)`   `Set targetSheet = newWB.Sheets(1)`   `With targetSheet`     `.Name = Left("委托单_" & criteria, 25) & "_" & (newWB.Sheets.Count - 1)``   `     `' 增强字段匹配逻辑`     `For Each cell In .UsedRange`       `If InStr(cell.Value, "自动获取") > 0 Then`         `Set leftCell = cell.Offset(0, -1)`         `colIndex = Application.Match(Trim(leftCell.Value), infoSheet.Rows(1), 0)``   `         `If Not IsError(colIndex) Then`           `' 处理日期格式`           `If IsDate(infoSheet.Cells(rowNum, colIndex).Value) Then`             `cell.Value = Format(infoSheet.Cells(rowNum, colIndex).Value, "yyyy-mm-dd")`           `Else`             `cell.Value = infoSheet.Cells(rowNum, colIndex).Value`           `End If`         `Else`           `cell.Value = "字段匹配失败"`         `End If`       `End If`     `Next cell`   `End With` `Next rowNum``   ` `' 保存优化（处理特殊字符）` `newWB.Sheets(1).Delete` `newWB.Sheets(1).Activate` `newWB.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\" & _`   `Replace(criteria, "/", "-") & "委托单.xlsx", _`   `FileFormat:=xlOpenXMLWorkbook` `MsgBox "成功生成 " & matchedRows.Count & " 张委托单！", vbInformation``End Sub

变量问题解决了，代码也进行了优化，但仍然存在1个未解决的问题：

newWB.Sheets(1).Delete不是删除在新建工作簿时自带的空工作表，而是将新添加的填写了信息的工作表给删除了。

我接着向deepseek提问：

上面的代码把不该删除的工作表给删除了，也就是新工作簿中已生成的工作表删除了而空工作表没有删除，请完善代码

这次虽然给出了修正，但又带来了新的问题，“委托单”填写的数量也有问题。本来还可以再接着问的，但我想我前面已经实现了我需要的功能，自己调整一下代码就行了，不想再花费时间试了。

最后，我选取了deepseek最初生成的代码并对其进行了稍微的修改，将新建工作簿保存在与当前工作簿相同的文件夹下。最终代码如下：

Sub GenerateCommissionSheetsPlus()` `Dim srcWB As Workbook, newWB As Workbook` `Dim infoSheet As Worksheet, templateSheet As Worksheet` `Dim criteria As String, lastRow As Long, i As Long` `Dim matchedRows As New Collection` `Dim Item As Variant` `Dim headerRow As Range, targetSheet As Worksheet` `Dim cell As Range, leftCell As Range, colIndex As Variant``   ` `Set srcWB = ThisWorkbook ' 假设代码在当前工作簿运行` `Set infoSheet = srcWB.Sheets("信息总表")` `Set templateSheet = srcWB.Sheets("委托单")``   ` `' 获取用户输入的使用单位` `criteria = InputBox("请输入要筛选的使用单位名称：", "输入筛选条件")` `If criteria = "" Then Exit Sub``   ` `' 在信息总表中查找匹配行` `With infoSheet`   `lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row`   `For i = 2 To lastRow ' 假设第1行为标题行`     `If .Cells(i, 1).Value = criteria Then matchedRows.Add i`   `Next i` `End With``   ` `If matchedRows.Count = 0 Then`   `MsgBox "未找到匹配的使用单位记录。", vbInformation`   `Exit Sub` `End If``   ` `' 创建新工作簿` `Set newWB = Workbooks.Add` `Application.DisplayAlerts = False` `While newWB.Sheets.Count > 1`   `newWB.Sheets(1).Delete` `Wend` `Application.DisplayAlerts = True``   ` `' 为每个匹配行创建委托单` `For Each Item In matchedRows`   `templateSheet.Copy after:=newWB.Sheets(Worksheets.Count)`   `Set targetSheet = newWB.Sheets(Worksheets.Count)`   `With targetSheet`     `.Name = "委托单" & newWB.Sheets.Count - 1`     `' 查找所有自动获取单元格`     `For Each cell In .UsedRange`       `If cell.Value Like "*自动获取*" Then`         `Set leftCell = cell.Offset(0, -1)`         `colIndex = Application.Match(leftCell.Value, infoSheet.Rows(1), 0)``   `         `If Not IsError(colIndex) Then`           `cell.Value = infoSheet.Cells(Item, colIndex).Value`         `Else`           `cell.Value = "数据未找到"`         `End If`       `End If`     `Next cell`   `End With` `Next Item``   ` `' 删除初始空白表并整理工作簿` `newWB.Sheets(1).Delete` `newWB.Sheets(1).Activate` `MsgBox "已生成 " & matchedRows.Count & " 张委托单！", vbInformation` `newWB.SaveAs Filename:=ThisWorkbook.Path & "\" & criteria & "委托单.xlsx"` `newWB.Close SaveChanges:=True``End Sub

看来，要想让deepseek帮助编写VBA代码，除了要有完整的提问外，还是要懂得VBA一些知识的。

如何学习大模型 AI ？

由于新岗位的生产效率，要优于被取代岗位的生产效率，所以实际上整个社会的生产效率是提升的。

但是具体到个人，只能说是：

“最先掌握AI的人，将会比较晚掌握AI的人有竞争优势”。

这句话，放在计算机、互联网、移动互联网的开局时期，都是一样的道理。

我在一线互联网企业工作十余年里，指导过不少同行后辈。帮助很多人得到了学习和成长。

我意识到有很多经验和知识值得分享给大家，也可以通过我们的能力和经验解答大家在人工智能学习中的很多困惑，所以在工作繁忙的情况下还是坚持各种整理和分享。但苦于知识传播途径有限，很多互联网行业朋友无法获得正确的资料得到学习提升，故此将并将重要的AI大模型资料包括AI大模型入门学习思维导图、精品AI大模型学习书籍手册、视频教程、实战学习等录播视频免费分享出来。

在这里插入图片描述