之前给大家分享了DeepSeek的使用方法，有粉丝反馈用它来写VBA代码真的太方便了，白嫖同事一杯咖啡，3分钟就搞定了！

其实使用DeepSeek来写代码非常的简单，我们只需要清楚的告诉DeepSeek你想要做什么，你的需求是什么，想要实现什么样的效果，总之就是提问的方法很重，要学会问问题，才能解决问题，也是需要稍微懂点Excel的

一、DeepSeek代码生成

如下图就是我们对DeepSeek的提问，大家可以仿照我的问题方式来做提问

目的：可否帮我使用VBA宏编写一个自定义函数，函数的名称为SumColor

实现的效果：要求能实现根据单元格背景色求和

函数参数要求：函数参数有2个，第一参数选中带有背景色的1个单元格，将单元格的背景色作为求和的条件，第二参数需要选择带有背景色的数据区域 对这个区域根据颜色求和

以上就是我的提问方式，当然如果你有更多的要求，尽量描述详细，要求越详细DeepSeek给出的结果越准确，

DeepSeek给出了如下代码，代码也是完成正确的，大家可以试一下

Function SumColor(rngCriteria As Range, rngSum As Range) As Double

Dim criteriaColor As Long

Dim cell As Range

Dim totalSum As Double

If rngCriteria.Count > 1 Then

SumColor = CVErr(xlErrValue)

Exit Function

End If

criteriaColor = rngCriteria.Interior.Color

totalSum = 0

For Each cell In rngSum

If cell.Interior.Color = criteriaColor Then

If IsNumeric(cell.Value) Then

totalSum = totalSum + cell.Value

End If

End If

Next cell

SumColor = totalSum

End Function

二、使用方式

想要使用VBA代码，需要在【开发工具】把代码粘贴到Excel的VB编辑器中的操作步骤如下

点击【开发工具】找到【Visual Basic】然后在左侧点击空白的区域，点击鼠标右键找到【插入】选择【模块】在新建的模块中粘贴代码即可

如果你是自定义的函数，就直接写等于号，填写函数名称

如果你是自定义的宏程序，就需要在【发开工具】中点击【宏】找到宏名称来运行宏

跟大家分享几个常用代码，也别找AI来一个一个问了，直接复制粘贴就能用啦

三、自动生成目录

这个代码可以实现自动生成目录，并且在每个工作表的坐上方都添加一个返回目录的按钮

Sub CreateWorksheetIndex()

Dim ws As Worksheet

Dim indexSheet As Worksheet

Dim i As Integer

Dim shp As Shape

Dim hyperlinkAddr As String

On Error Resume Next

Set indexSheet = Worksheets("目录")

If indexSheet Is Nothing Then

Set indexSheet = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))

indexSheet.Name = "目录"

End If

On Error GoTo 0

indexSheet.Cells.ClearContents

indexSheet.Cells(1, 1).Value = "工作表目录"

i = 2

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> indexSheet.Name Then

indexSheet.Hyperlinks.Add Anchor:=indexSheet.Cells(i, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name

Set shp = ws.Shapes.AddShape(msoShapeRectangle, 10, 10, 80, 20)

shp.TextFrame.Characters.Text = "返回目录"

hyperlinkAddr = "'" & indexSheet.Name & "'!A1"

ws.Hyperlinks.Add Anchor:=shp, Address:="", SubAddress:=hyperlinkAddr

i = i + 1

End If

Next ws

End Sub

四、图片批量插入Excel

这个代码可以将文件夹中的图片提取名称并且批量的插入到Excel表格中，只需要更改代码中的

C:\Users\yh\Desktop\演示图片\

替换为你的文件地址即可

Sub InsertPicturesAndNames()

Dim folderPath As String

Dim fileName As String

Dim ws As Worksheet

Dim rowIndex As Long

Dim pic As Picture

Dim namePart As String

folderPath = "C:\Users\yh\Desktop\演示图片\"

If Dir(folderPath, vbDirectory) = "" Then

MsgBox "指定的文件夹不存在，请检查路径。"

Exit Sub

End If

Set ws = ActiveSheet

rowIndex = 1

fileName = Dir(folderPath & "*.jpg")

Do While fileName <> ""

namePart = Left(fileName, InStrRev(fileName, ".") - 1)

ws.Cells(rowIndex, 1).Value = namePart

Set pic = ws.Pictures.Insert(folderPath & fileName)

With pic

.Left = ws.Cells(rowIndex, 2).Left

.Top = ws.Cells(rowIndex, 2).Top

.Height = 40

.Width = 40

End With

ws.Rows(rowIndex).RowHeight = pic.Height

ws.Columns(2).ColumnWidth = pic.Width / 20

rowIndex = rowIndex + 1

fileName = Dir

Loop

fileName = Dir(folderPath & "*.png")

Do While fileName <> ""

namePart = Left(fileName, InStrRev(fileName, ".") - 1)

ws.Cells(rowIndex, 1).Value = namePart

Set pic = ws.Pictures.Insert(folderPath & fileName)

With pic

.Left = ws.Cells(rowIndex, 2).Left

.Top = ws.Cells(rowIndex, 2).Top

.Height = 40

.Width = 40

End With

ws.Rows(rowIndex).RowHeight = pic.Height

ws.Columns(2).ColumnWidth = pic.Width / 20

rowIndex = rowIndex + 1

fileName = Dir

Loop

fileName = Dir(folderPath & "*.gif")

Do While fileName <> ""

namePart = Left(fileName, InStrRev(fileName, ".") - 1)

ws.Cells(rowIndex, 1).Value = namePart

Set pic = ws.Pictures.Insert(folderPath & fileName)

With pic

.Left = ws.Cells(rowIndex, 2).Left

.Top = ws.Cells(rowIndex, 2).Top

.Height = 40

.Width = 40

End With

ws.Rows(rowIndex).RowHeight = pic.Height

ws.Columns(2).ColumnWidth = pic.Width / 20

rowIndex = rowIndex + 1

fileName = Dir

Loop

MsgBox "图片和姓名插入完成，行高和列宽已调整。"

End Sub

五、根据颜色计数

这个是自定义了一个名称为CountColor的函数，用于根据单元格统计颜色，参数有2个，第一参数设置为箱套统计背景色的单元格，第二参数为统计的区域

Function CountColor(rngCriteria As Range, rngSum As Range) As Long

Dim criteriaColor As Long

Dim cell As Range

Dim countResult As Long

If rngCriteria.Count > 1 Then

CountColor = CVErr(xlErrValue)

Exit Function

End If

criteriaColor = rngCriteria.Interior.Color

countResult = 0

For Each cell In rngSum

If cell.Interior.Color = criteriaColor Then

countResult = countResult + 1

End If

Next cell

CountColor = countResult

End Function

六、数字转金额大写

这个是自定义了一个名称为DXZH的函数，参数只有一个，就是需要转换的单元格，直接粘贴代码使用即可

Function DXZH(ByVal MyNumber)

Dim Yuan As String

Dim Jiao As String

Dim Fen As String

Dim Temp As String

Dim DecimalPlace As Integer

Dim Count As Integer

Dim DigitArr As Variant

Dim UnitArr As Variant

Dim StrNumber As String

DigitArr = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")

UnitArr = Array("", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟")

If MyNumber < 0 Then

DXZH = "负"

MyNumber = -MyNumber

Else

DXZH = ""

End If

StrNumber = Trim(Str(MyNumber))

DecimalPlace = InStr(StrNumber, ".")

If DecimalPlace > 0 Then

Yuan = Left(StrNumber, DecimalPlace - 1)

Jiao = Mid(StrNumber, DecimalPlace + 1, 1)

Fen = Mid(StrNumber, DecimalPlace + 2, 1)

Else

Yuan = StrNumber

Jiao = "0"

Fen = "0"

End If

If Val(Yuan) > 0 Then

Temp = ""

Count = 1

For i = Len(Yuan) To 1 Step -1

Temp = DigitArr(Val(Mid(Yuan, i, 1))) & UnitArr(Count - 1) & Temp

Count = Count + 1

Next i

Do While InStr(Temp, "零拾") > 0

Temp = Replace(Temp, "零拾", "零")

Loop

Do While InStr(Temp, "零佰") > 0

Temp = Replace(Temp, "零佰", "零")

Loop

Do While InStr(Temp, "零仟") > 0

Temp = Replace(Temp, "零仟", "零")

Loop

Do While InStr(Temp, "零万") > 0

Temp = Replace(Temp, "零万", "万")

Loop

Do While InStr(Temp, "零亿") > 0

Temp = Replace(Temp, "零亿", "亿")

Loop

Do While InStr(Temp, "零零") > 0

Temp = Replace(Temp, "零零", "零")

Loop

Do While Right(Temp, 1) = "零"

Temp = Left(Temp, Len(Temp) - 1)

Loop

If Temp <> "" Then

DXZH = DXZH & Temp & "元"

End If

End If

If Val(Jiao) > 0 Then

DXZH = DXZH & DigitArr(Val(Jiao)) & "角"

ElseIf Val(Fen) > 0 Then

DXZH = DXZH & "零"

End If

If Val(Fen) > 0 Then

DXZH = DXZH & DigitArr(Val(Fen)) & "分"

ElseIf DXZH <> "" Then

DXZH = DXZH & "整"

Else

DXZH = "零元整"

End If

End Function

至此今天分享就完毕了，利用AI工具来写代码还是非常方便的，关键是要说清楚自己的需求

还有就是WPS表格默认不支持VBA宏，默认支持JS宏，但是我让AI编写JS宏总是出现错误，看来AI也不是万能的啊，对这方面的支持还是不行，如你是WPS可以安装vba库做支持，就能在WPS中使用VBA代码了