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

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

一、DeepSeek代码生成

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

用DeepSeek写VBA，3分钟白嫖同事1杯咖啡，难道说这才是正确用法？

目的：可否帮我使用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编辑器中的操作步骤如下

用DeepSeek写VBA，3分钟白嫖同事1杯咖啡，难道说这才是正确用法？

点击【开发工具】找到【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:UsersyhDesktop演示图片

替换为你的文件地址即可

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:UsersyhDesktop演示图片"
    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