【VBA】点击按钮，实现将Excel表A数据按格式填入表B

一、需求描述

数据源表会按照一定的格式填写，包含基本信息、操作流程、操作的有效时间、无效时间等。点击目标表下方功能按钮区的“新增”按钮时，能够自动将数据源表的信息按格式自动填入目标表中。

二、VBA代码

在VBE中编写VBA代码，在目标表（sheet4）中写主程序

sheet4程序：

' 按钮点击事件 - 这段代码必须放在线平衡墙Sheet的代码模块中
Private Sub Button1_Click()' 启用错误处理，指定错误处理程序标签On Error GoTo ErrorHandler' 声明变量Dim sourceSheetName As StringDim wsSource As Worksheet      ' 源工作表（数据来源）Dim wsTarget As Worksheet      ' 目标工作表（按钮所在表）Dim targetCell As Range        ' 找到的空单元格Dim searchResult As Boolean    ' 查找结果标志Dim lastRow As Long, i As Long, targetRow As Long  ' 用于记录作业和步行时长数量Dim dataCount As LongDim colNumber As Long          '获取目标单元格所在列' 初始化searchResult = False' 设置目标工作表为当前工作表（Sheet4）Set wsTarget = ThisWorkbook.Sheets("线平衡墙宏制作")   ' Me 代表当前工作表' 从D202单元格获取源工作表名称sourceSheetName = Trim(wsTarget.Range("D202").Value)' 验证输入If sourceSheetName = "" ThenMsgBox "D202单元格为空！" & vbCrLf & "请输入源工作表的名称（例如：GA1-A022R.2）", vbExclamation, "输入提示"Exit SubEnd If' 检查源工作表是否存在If Not WorksheetExists(sourceSheetName) ThenMsgBox "名为 '" & sourceSheetName & "' 的工作表不存在！" & vbCrLf & _"请检查D202单元格的工作表名称是否正确。", vbCritical, "工作表不存在"Exit SubEnd IfSet wsSource = ThisWorkbook.Sheets(sourceSheetName)' 检查源数据单元格是否为空If IsEmpty(wsSource.Range("E1")) ThenMsgBox "源工作表 '" & sourceSheetName & "' 的E1工位号单元格为空！", vbExclamation, "数据为空"Exit SubEnd If' 查找第一个空单元格（间隔查找）Set targetCell = FindEmptyCellWithInterval(wsTarget.Range("I189"))' 填入数据If Not targetCell Is Nothing Then'Call FormatSingleCell(targetCell) ' 调用一个单元格格式规范函数' 格式化下方第1~3个单元格'Call FormatCellRange(targetCell.Offset(-1, 0).Resize(3, 1))' 格式化下方第5个单元格'Call FormatCellRange(targetCell.Offset(3, 0))' 格式化下方第8个单元格'Call FormatCellRange(targetCell.Offset(6, 0))'合成一句Call FormatCellRange(Union(targetCell.Offset(-1, 0).Resize(3, 1), targetCell.Offset(3, 0), targetCell.Offset(6, 0)))'MsgBox "格式设置完成！"'============线平衡墙（下）制作===============targetCell.Value = wsSource.Range("E1").Value ' 工位号targetCell.Offset(-1, 0).Value = wsSource.Range("C5").Value   ' 车型targetCell.Offset(1, 0).Value = wsSource.Range("N25").Value ' CTtargetCell.Offset(3, 0).Value = wsSource.Range("B3").Value ' ATT' 计算I8:I25的和并赋值给targetCelltargetCell.Offset(6, 0).Value = WorksheetFunction.Sum(wsSource.Range("I8:I25")) ' 步行时间'===========线平衡墙（上）制作=================colNumber = targetCell.Column   ' colNumber 返回列号（数字），比如A列返回1，B列返回2'获取源数据的最后一行lastRow = wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row'直接指定处理H8:H25范围For rowNum = 8 To 25If wsSource.Cells(rowNum, "H").Value = "" ThenExit For  '遇到空行就停止循环End If'处理有数据的行...Next rowNum'初始化目标行（从第187行开始向上写）targetRow = 187dataCount = 0'遍历源数据的每一行For i = 8 To rowNumDim startRow As Integer, endRow As Integer   '合并单元格所用Dim isValue As Boolean  '检查备注是否为"增值"isValue = (UCase(Trim(wsSource.Cells(i, "V").Value)) = "增值")startRow = targetRow'获取A列的值（有效时间）If wsSource.Cells(i, "H").Value <> "" ThenwsTarget.Cells(targetRow, colNumber).Value = wsSource.Cells(i, "G").Value & wsSource.Cells(i, "H").Value & "秒"'调用模块函数设置格式,合并单元格For j = wsSource.Cells(i, "H").Value To 1 Step -1FormatByImportance wsTarget.Cells(targetRow, colNumber), isValuetargetRow = targetRow - 1Next jendRow = targetRow + 1'Range(Cells(startRow, colNumber), Cells(endRow, colNumber)).Merge '合并单元格'合并单元格，水平和垂直居中,用with进行一系列操作With Range(Cells(startRow, colNumber), Cells(endRow, colNumber)).Merge.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd WithdataCount = dataCount + 1End IfstartRow = targetRow'获取I列的值（步行时间），如果非0则输出If wsSource.Cells(i, "H").Value <> "" And wsSource.Cells(i, "I").Value <> 0 ThenwsTarget.Cells(targetRow, colNumber).Value = "步行时间" & wsSource.Cells(i, "I").Value & "秒"'调用模块函数设置格式For j = wsSource.Cells(i, "H").Value To 1 Step -1ApplyRedFill (wsTarget.Cells(targetRow, colNumber))targetRow = targetRow - 1Next jendRow = targetRow + 1'合并单元格With Range(Cells(startRow, colNumber), Cells(endRow, colNumber)).Merge.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd WithdataCount = dataCount + 1End IfNext i'===============================searchResult = True' 成功提示'MsgBox "数据获取成功！" & vbCrLf & vbCrLf & _"数据来源：" & sourceSheetName & "的E1单元格" & vbCrLf & _"填入位置：" & wsTarget.Name & "的" & targetCell.Address(False, False) & "单元格" & vbCrLf & _"单元格值：" & targetCell.Value, _vbInformation , "操作完成"ElseMsgBox "未找到可用的空单元格！" & vbCrLf & _"从I189开始向右间隔查找的单元格都已占用。", vbExclamation, "查找失败"End IfCleanup:' 清理对象变量Set wsSource = NothingSet wsTarget = NothingSet targetCell = NothingExit SubErrorHandler:MsgBox "运行时错误 #" & Err.Number & "：" & Err.Description, vbCritical, "系统错误"Resume Cleanup
End Sub' 辅助函数：检查工作表是否存在（放在同一个Sheet4模块中）
Private Function WorksheetExists(sheetName As String) As BooleanOn Error Resume NextWorksheetExists = (ThisWorkbook.Sheets(sheetName).Name <> "")On Error GoTo 0
End Function' 辅助函数：间隔查找空单元格（放在同一个Sheet4模块中）
Private Function FindEmptyCellWithInterval(startCell As Range) As RangeDim currentCell As RangeDim maxAttempts As IntegerDim attemptCount As IntegerSet currentCell = startCellmaxAttempts = 10  ' 最大查找10个位置attemptCount = 0' 间隔查找：B3, D3, F3, H3, J3, L3, N3, P3, R3, T3Do While attemptCount < maxAttemptsIf IsEmpty(currentCell) ThenSet FindEmptyCellWithInterval = currentCellExit FunctionEnd If' 向右移动2列（间隔1个单元格）Set currentCell = currentCell.Offset(0, 2)attemptCount = attemptCount + 1Loop' 未找到空单元格Set FindEmptyCellWithInterval = Nothing
End Function

在模块中写方法类:
(1)FormatModuleArea,规范一个范围的单元格格式

' =============================================
' 方法名称：FormatCellRange
' 描述：设置单元格区域的字体、填充色和对齐方式
' 参数：targetRange - 要格式化的单元格区域
' =============================================
Public Sub FormatCellRange(ByVal targetRange As Range)On Error GoTo ErrorHandler' 检查参数是否有效If targetRange Is Nothing ThenMsgBox "错误：目标区域不能为空！", vbExclamationExit SubEnd If' 关闭屏幕更新，提高性能Application.ScreenUpdating = False' 应用格式设置到整个区域With targetRange' 字体设置With .Font.Name = "宋体".Size = 10.Color = RGB(0, 0, 0)   ' 黑色.Bold = True            ' 加粗End With' 填充色设置.Interior.Color = RGB(0, 176, 240)  ' 主题蓝' 对齐方式.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd With' 恢复屏幕更新Application.ScreenUpdating = True' 成功提示'MsgBox "区域格式化完成！共格式化 " & targetRange.Cells.Count & " 个单元格", vbInformationExit SubErrorHandler:' 确保恢复屏幕更新Application.ScreenUpdating = TrueMsgBox "格式化区域时出错：" & Err.Description, vbCritical
End Sub

(2)FormatModuleSingle,规范一个单元格格式

Option Explicit' =============================================
' 方法名称：FormatSingleCell
' 描述：设置单元格字体、填充色和对齐方式
' 参数：targetCell - 要格式化的单元格
' =============================================
Public Sub FormatSingleCell(ByVal targetCell As Range)On Error GoTo ErrorHandler' 检查参数是否有效If targetCell Is Nothing ThenMsgBox "错误：目标单元格不能为空！", vbExclamationExit SubEnd If' 应用格式设置With targetCell' 字体设置With .Font.Name = "宋体".Size = 10.Color = RGB(0, 0, 0)   ' 黑色.Bold = True            ' 加粗End With' 填充色设置.Interior.Color = RGB(0, 176, 240)  '主题蓝' 对齐方式.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd With' 可选：设置测试文本'targetCell.Value = "格式化成功"Exit SubErrorHandler:MsgBox "格式化单元格时出错：" & Err.Description, vbCritical
End Sub

（3）ModuleFill，单元格填充背景色的规范

' LC参考自AI
' 功能：提供单元格格式设置的通用函数'设置红色填充格式
Public Sub ApplyRedFill(cell As Range)On Error GoTo ErrorHandlerWith cell.Interior.Color = RGB(255, 0, 0)    '红色.Pattern = xlSolid         '实心填充.TintAndShade = 0End WithExit Sub
ErrorHandler:MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub'设置黄色填充格式
Public Sub ApplyYellowFill(cell As Range)On Error GoTo ErrorHandlerWith cell.Interior.Color = RGB(255, 255, 0)  '黄色.Pattern = xlSolid.TintAndShade = 0End WithExit Sub
ErrorHandler:MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub'设置绿色填充格式
Public Sub ApplyGreenFill(cell As Range)On Error GoTo ErrorHandlerWith cell.Interior.Color = RGB(0, 255, 0)  '绿色.Pattern = xlSolid.TintAndShade = 0End WithExit Sub
ErrorHandler:MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub'清除单元格填充格式
Public Sub ClearCellFill(cell As Range)On Error GoTo ErrorHandlercell.Interior.Pattern = xlNone  '无填充Exit Sub
ErrorHandler:MsgBox "清除格式时出错：" & Err.Description, vbExclamation
End Sub'根据重要性设置格式的通用函数
Public Sub FormatByImportance(cell As Range, isValue As Boolean)If isValue ThenApplyGreenFill cellElseApplyYellowFill cellEnd If
End Sub

三、相关知识

来源于https://www.bilibili.com/video/BV1ax4y1V7qi/

（1）HorizontalAlignment 属性

（2）Font属性ColorIndex单元格背景颜色

（3）运算符

（4）常用内置函数

四、个人感悟

按捺住节日将至迎接小长假的激动心情，赶在下班前完成初步工作需求，后续再继续完善其他功能。需继续思考，如何更好地实现需求，满足拓展。感谢AI，能不厌其烦地准确回答我的问题，科技越来越强大了，感谢背后的工作者！祝双节快乐！