用DeepSeek寫VBA，3分鐘白嫖同事1杯咖啡，難道這才是正確用法？

之前給大家分享了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代碼了