之前給大家分享了DeepSeek的使用方法，有粉絲反饋用它來(lái)寫VBA代碼真的太方便了，白嫖同事一杯咖啡，3分鐘就搞定了！

其實(shí)使用DeepSeek來(lái)寫代碼非常的簡(jiǎn)單，我們只需要清楚的告訴DeepSeek你想要做什么，你的需求是什么，想要實(shí)現(xiàn)什么樣的效果，總之就是提問(wèn)的方法很重，要學(xué)會(huì)問(wèn)問(wèn)題，才能解決問(wèn)題，也是需要稍微懂點(diǎn)Excel的

一、DeepSeek代碼生成

如下圖就是我們對(duì)DeepSeek的提問(wèn)，大家可以仿照我的問(wèn)題方式來(lái)做提問(wèn)

目的：可否幫我使用VBA宏編寫一個(gè)自定義函數(shù)，函數(shù)的名稱為SumColor

實(shí)現(xiàn)的效果：要求能實(shí)現(xiàn)根據(jù)單元格背景色求和

函數(shù)參數(shù)要求：函數(shù)參數(shù)有2個(gè)，第一參數(shù)選中帶有背景色的1個(gè)單元格，將單元格的背景色作為求和的條件，第二參數(shù)需要選擇帶有背景色的數(shù)據(jù)區(qū)域 對(duì)這個(gè)區(qū)域根據(jù)顏色求和

以上就是我的提問(wèn)方式，當(dāng)然如果你有更多的要求，盡量描述詳細(xì)，要求越詳細(xì)DeepSeek給出的結(jié)果越準(zhǔn)確，

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代碼，需要在【開發(fā)工具】把代碼粘貼到Excel的VB編輯器中的操作步驟如下

點(diǎn)擊【開發(fā)工具】找到【Visual Basic】然后在左側(cè)點(diǎn)擊空白的區(qū)域，點(diǎn)擊鼠標(biāo)右鍵找到【插入】選擇【模塊】在新建的模塊中粘貼代碼即可

如果你是自定義的函數(shù)，就直接寫等于號(hào)，填寫函數(shù)名稱

如果你是自定義的宏程序，就需要在【發(fā)開工具】中點(diǎn)擊【宏】找到宏名稱來(lái)運(yùn)行宏

跟大家分享幾個(gè)常用代碼，也別找AI來(lái)一個(gè)一個(gè)問(wèn)了，直接復(fù)制粘貼就能用啦

三、自動(dòng)生成目錄

這個(gè)代碼可以實(shí)現(xiàn)自動(dòng)生成目錄，并且在每個(gè)工作表的坐上方都添加一個(gè)返回目錄的按鈕

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

這個(gè)代碼可以將文件夾中的圖片提取名稱并且批量的插入到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 "指定的文件夾不存在，請(qǐng)檢查路徑。"

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 "圖片和姓名插入完成，行高和列寬已調(diào)整。"

End Sub

五、根據(jù)顏色計(jì)數(shù)

這個(gè)是自定義了一個(gè)名稱為CountColor的函數(shù)，用于根據(jù)單元格統(tǒng)計(jì)顏色，參數(shù)有2個(gè)，第一參數(shù)設(shè)置為箱套統(tǒng)計(jì)背景色的單元格，第二參數(shù)為統(tǒng)計(jì)的區(qū)域

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

六、數(shù)字轉(zhuǎn)金額大寫

這個(gè)是自定義了一個(gè)名稱為DXZH的函數(shù)，參數(shù)只有一個(gè)，就是需要轉(zhuǎn)換的單元格，直接粘貼代碼使用即可

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("", "拾", "佰", "仟", "萬(wàn)", "拾", "佰", "仟", "億", "拾", "佰", "仟")

If MyNumber < 0 Then

DXZH = "負(fù)"

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, "零萬(wàn)") > 0

Temp = Replace(Temp, "零萬(wàn)", "萬(wàn)")

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工具來(lái)寫代碼還是非常方便的，關(guān)鍵是要說(shuō)清楚自己的需求

還有就是WPS表格默認(rèn)不支持VBA宏，默認(rèn)支持JS宏，但是我讓AI編寫JS宏總是出現(xiàn)錯(cuò)誤，看來(lái)AI也不是萬(wàn)能的啊，對(duì)這方面的支持還是不行，如你是WPS可以安裝vba庫(kù)做支持，就能在WPS中使用VBA代碼了