excel VBA代码分享

VBA 能帮你自动化处理 Excel 中大量重复性的工作。这里直接分享几段我筛选出的高频代码，并附上解读和风险提示，你可以直接复制到 VBA 编辑器中使用。

⚠️ 代码安全须知：VBA 宏可能包含恶意代码。请勿在未核代码源的情况下，启用或运行来源不明的 .xlsm 文件。在运行任何宏之前，请务必确认代码的功能和来源。

🚀 基础环境准备

在开始之前，请先确保已开启“开发工具”选项卡（文件 > 选项 > 自定义功能区）。要使用VBA代码，请按 Alt + F11 打开VBA编辑器，通过菜单“插入 > 模块”新建一个模块，然后将代码粘贴进去，最后按 F5 运行。

为追求最佳执行效率，你写的代码可以参照以下范式，在开头和结尾插入这两行标准语句，它们能在运行时暂时关闭屏幕刷新和自动重算，加速代码运行，待宏执行完毕后再恢复。

' 推荐的标准代码结构

Application.ScreenUpdating = False ' 关闭屏幕刷新

Application.Calculation = xlCalculationManual ' 关闭自动重算' 

... 

你的核心操作代码 

...

Application.ScreenUpdating = True ' 恢复屏幕刷新

Application.Calculation = xlCalculationAutomatic ' 恢复自动重算

📊 数据处理四件套

下面这几段代码非常实用，主要用于数据清洗和转换，可以直接应用到日常工作场景中。

1. 批量提取/筛选数据 (条件复制)

从大量数据中提取符合条件的信息。代码会遍历源数据，判断语文成绩是否大于85分，若满足条件则将整行复制到目标工作表，并对结果进行加粗和蓝色底纹的格式美化。

Sub ExtractAndFormatData()    

Dim sourceSheet As Worksheet, targetSheet As Worksheet    

Dim lastRow As Long, i As Long, j As Long    

Set sourceSheet = ThisWorkbook.Sheets("Sheet1")    

Set targetSheet = ThisWorkbook.Sheets("Sheet2")    

lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row    

j = 1 ' 目标表的行号计数器    

For i = 1 To lastRow        

    If sourceSheet.Cells(i, 2).Value > 85 Then ' 若B列（语文）成绩大于85            

        sourceSheet.Rows(i).Copy Destination:=targetSheet.Rows(j)      

        j = j + 1        

    End If    

Next i    ' 对复制后的数据进行格式化    

lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row    

With targetSheet.Range("A1:D" & lastRow)        

    .Font.Bold = True ' 字体加粗        

    .Interior.Color = RGB(176, 224, 230) ' 设置背景色为浅蓝色    

End With

End Sub

2. 批量合并单元格 (填充空白)

处理B列存在不规则空白的表格时，此代码自动用上方非空值填充空白，再将相同连续值合并成一个单元格，适用于清洗层级报表或分类汇总前的预处理。

Sub FillAndMergeCells()    

Dim lastRow As Long, i As Long    

Dim currentVal As Variant    

lastRow = Cells(Rows.Count, "B").End(xlUp).Row ' 获取B列最后非空行号    

' 第一步：向下填充空白单元格    

For i = 2 To lastRow        

    If IsEmpty(Cells(i, "B")) Then            

        Cells(i, "B") = Cells(i - 1, "B")        

    End If    

Next i    

' 第二步：合并相同值的连续单元格    

currentVal = Cells(2, "B").Value    

Dim startRow As Integer

startRow = 2    

For i = 3 To lastRow + 1        

    If Cells(i, "B").Value <> currentVal Then            

        Range(Cells(startRow, "B"), Cells(i - 1, "B")).Merge            

        currentVal = Cells(i, "B").Value            

        startRow = i        

    End If    

Next i

End Sub

3. 批量删除空行

遍历A列，若发现单元格为空，则删除该行。此操作会向上移动下方单元格，建议在操作前备份数据。

Sub DeleteBlankRows()    

Dim lastRow As Long, i As Long    

lastRow = ActiveSheet.UsedRange.Rows.Count ' 获取使用区域的行数    

' 从下往上遍历，避免漏删    

For i = lastRow To 1 Step -1        

    If IsEmpty(ActiveSheet.Cells(i, 1).Value) Then            

        ActiveSheet.Rows(i).Delete        

    End If    

Next i

End Sub

4. 批量替换公式文本

快速将选中区域内公式中的"A"替换为"B"。注意：此代码只作用于包含公式的单元格，普通文本不受影响。

Sub ReplaceFormulaText()    

Dim rng As Range, cell As Range    

Set rng = Selection ' 获取用户当前选择的区域    

For Each cell In rng        

    If cell.HasFormula Then ' 检查单元格是否包含公式            

        cell.Formula = Replace(cell.Formula, "A", "B")        

    End If    

Next cell

End Sub

📁 工作簿与文件批处理

合并多个工作簿

从指定文件夹选取多个Excel文件，将各自的第一张工作表合并至当前工作簿并改名为源文件名，最后弹出消息提示完成。

Sub MergeWorkbook()    

Dim MyPath As String, MyName As String    

Dim wb As Workbook, DestWB As Workbook    

Dim LastRowDest As Long    

Set DestWB = ThisWorkbook ' 目标工作簿为代码所在文件    

Application.ScreenUpdating = False    ' 获取当前文件所在路径    

MyPath = ThisWorkbook.Path & "\"    

MyName = Dir(MyPath & "*.xls*") ' 遍历所有Excel文件    

Do While MyName <> ""        

    If MyName <> ThisWorkbook.Name Then            

        Set wb = Workbooks.Open(MyPath & MyName)                    

        '复制源文件的第一张工作表到最后            

        wb.Sheets(1).Copy After:=DestWB.Sheets(DestWB.Sheets.Count)  

        ' 将新复制的工作表命名为原文件名            

        ActiveSheet.Name = Left(MyName, InStrRev(MyName, ".") - 1)            

        wb.Close SaveChanges:=False        

    End If        

    MyName = Dir    

Loop    

Application.ScreenUpdating = True    

MsgBox "工作簿合并完成！"

End Sub

🖥️ 创建交互界面 (UserForm)

通过用户窗体可构建图形化登录界面，点击按钮验证密码（示例为硬编码）并提升交互性，结合之前的基础操作可开发简单的权限管理工具。

1. 在VBA编辑器中，右键项目，选择“插入”>“用户窗体”。

2. 从工具箱向窗体拖入两个文本框(TextBox)、两个标签(Label)和一个按钮(CommandButton)，用属性窗口修改名称及显示文字。

3. 双击按钮，粘贴以下登录验证逻辑。

Private Sub CommandButton1_Click()    

If TextBox1.Text = "admin" And TextBox2.Text = "123456" Then        

    MsgBox "登录成功！", vbInformation        

   ' 此处可添加登录成功后的动作，如显示特定工作表    

Else        

    MsgBox "用户名或密码错误！", vbCritical        

    TextBox1.Text = ""        

    TextBox2.Text = ""        

    TextBox1.SetFocus    

End If

End Sub

💡 实用函数与技巧

在VBA逻辑中，巧妙地使用Range对象和数组可以大幅提升性能。处理数据时可以遵循一些关键技巧：

• 遍历数据：使用For Each循环遍历筛选后的数据区域，或在条件满足时操作，对处理速度影响极大。

• 变量声明：模块顶部使用Option Explicit强制声明变量，可避免因变量名写错而引发的逻辑错误。

• 错误处理：在代码开头加入On Error GoTo ErrorHandler，并在末尾设置ErrorHandler:标签处理意外状况，可防止代码因未预见错误而崩溃。

这段代码主要操作一个二维数组，演示了如何将单元格区域的值读取到内存数组中，然后在数组上进行所有计算，最后再将结果一次性写回工作表。这种方法在处理大量数据时，速度会比直接在单元格上循环快很多。

Sub ProcessDataInArray()    

Dim dataRange As Variant    

Dim i As Long, j As Long    ' 将单元格区域的值一次性读入数组    

dataRange = Range("A1:C100").Value    ' 在数组中进行数据处理（循环）    

For i = 1 To UBound(dataRange, 1)        

    For j = 1 To UBound(dataRange, 2)            

        If IsNumeric(dataRange(i, j)) Then                

            dataRange(i, j) = dataRange(i, j) * 2 ' 数值加倍            

        End If        

    Next j    

Next i    ' 将处理好的数组结果写回单元格区域    

Range("A1:C100").Value = dataRange

End Sub

💎 总结与建议

这些代码框架覆盖了Excel自动化的多个核心方面，能处理大部分重复性工作。如需更多资料，可以查阅微软官方文档，或在CSDN、腾讯云开发者社区等平台搜索更多深度案例。

Range.Value是VBA处理单元格最常用的方式，它可以直接读写数据，是连接逻辑与工作表的桥梁。你还可以利用Range("A1", "C10")等方式精准定位数据区域。