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

一、需求描述

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

二、VBA代码

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

sheet4程序：

' 按钮点击事件 - 这段代码必须放在线平衡墙Sheet的代码模块中
Private Sub Button1_Click()
    ' 启用错误处理，指定错误处理程序标签
    On Error GoTo ErrorHandler
    
    ' 声明变量
    Dim sourceSheetName As String
    Dim 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 Long
    Dim colNumber As Long          '获取目标单元格所在列

    
    ' 初始化
    searchResult = False
    
    ' 设置目标工作表为当前工作表（Sheet4）
    Set wsTarget = ThisWorkbook.Sheets("线平衡墙宏制作")   ' Me 代表当前工作表
    
    ' 从D202单元格获取源工作表名称
    sourceSheetName = Trim(wsTarget.Range("D202").Value)
    
    ' 验证输入
    If sourceSheetName = "" Then
        MsgBox "D202单元格为空！" & vbCrLf & "请输入源工作表的名称（例如：GA1-A022R.2）", vbExclamation, "输入提示"
        Exit Sub
    End If
    
    ' 检查源工作表是否存在
    If Not WorksheetExists(sourceSheetName) Then
        MsgBox "名为 '" & sourceSheetName & "' 的工作表不存在！" & vbCrLf & _
               "请检查D202单元格的工作表名称是否正确。", vbCritical, "工作表不存在"
        Exit Sub
    End If
    
    Set wsSource = ThisWorkbook.Sheets(sourceSheetName)
    
    ' 检查源数据单元格是否为空
    If IsEmpty(wsSource.Range("E1")) Then
        MsgBox "源工作表 '" & sourceSheetName & "' 的E1工位号单元格为空！", vbExclamation, "数据为空"
        Exit Sub
    End 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 ' CT
        targetCell.Offset(3, 0).Value = wsSource.Range("B3").Value ' ATT
        ' 计算I8:I25的和并赋值给targetCell
        targetCell.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 25
            If wsSource.Cells(rowNum, "H").Value = "" Then
                Exit For  '遇到空行就停止循环
            End If
            '处理有数据的行...
            Next rowNum
        
        '初始化目标行（从第187行开始向上写）
        targetRow = 187
        dataCount = 0
        
        '遍历源数据的每一行
        For i = 8 To rowNum
            Dim 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 <> "" Then
                wsTarget.Cells(targetRow, colNumber).Value = wsSource.Cells(i, "G").Value & wsSource.Cells(i, "H").Value & "秒"
                '调用模块函数设置格式,合并单元格
                For j = wsSource.Cells(i, "H").Value To 1 Step -1
                    FormatByImportance wsTarget.Cells(targetRow, colNumber), isValue
                    targetRow = targetRow - 1
                    Next j
                endRow = targetRow + 1
                'Range(Cells(startRow, colNumber), Cells(endRow, colNumber)).Merge '合并单元格
                '合并单元格，水平和垂直居中,用with进行一系列操作
                With Range(Cells(startRow, colNumber), Cells(endRow, colNumber))
                     .Merge
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlCenter
                End With
                dataCount = dataCount + 1
            End If
                    
            startRow = targetRow
            '获取I列的值（步行时间），如果非0则输出
            If wsSource.Cells(i, "H").Value <> "" And wsSource.Cells(i, "I").Value <> 0 Then
                wsTarget.Cells(targetRow, colNumber).Value = "步行时间" & wsSource.Cells(i, "I").Value & "秒"
                '调用模块函数设置格式
                For j = wsSource.Cells(i, "H").Value To 1 Step -1
                    ApplyRedFill (wsTarget.Cells(targetRow, colNumber))
                    targetRow = targetRow - 1
                    Next j
                endRow = targetRow + 1
                '合并单元格
                With Range(Cells(startRow, colNumber), Cells(endRow, colNumber))
                     .Merge
                     .HorizontalAlignment = xlCenter
                     .VerticalAlignment = xlCenter
                End With
                dataCount = dataCount + 1
            End If
            
            Next i
    
         '===============================
        
        
        searchResult = True
        ' 成功提示
        'MsgBox "数据获取成功！" & vbCrLf & vbCrLf & _
               "数据来源：" & sourceSheetName & "的E1单元格" & vbCrLf & _
               "填入位置：" & wsTarget.Name & "的" & targetCell.Address(False, False) & "单元格" & vbCrLf & _
               "单元格值：" & targetCell.Value, _
               vbInformation , "操作完成"
    Else
        MsgBox "未找到可用的空单元格！" & vbCrLf & _
               "从I189开始向右间隔查找的单元格都已占用。", vbExclamation, "查找失败"
    End If

Cleanup:
    ' 清理对象变量
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set targetCell = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "运行时错误 #" & Err.Number & "：" & Err.Description, vbCritical, "系统错误"
    Resume Cleanup
End Sub

' 辅助函数：检查工作表是否存在（放在同一个Sheet4模块中）
Private Function WorksheetExists(sheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (ThisWorkbook.Sheets(sheetName).Name <> "")
    On Error GoTo 0
End Function

' 辅助函数：间隔查找空单元格（放在同一个Sheet4模块中）
Private Function FindEmptyCellWithInterval(startCell As Range) As Range
    Dim currentCell As Range
    Dim maxAttempts As Integer
    Dim attemptCount As Integer
    
    Set currentCell = startCell
    maxAttempts = 10  ' 最大查找10个位置
    attemptCount = 0
    
    ' 间隔查找：B3, D3, F3, H3, J3, L3, N3, P3, R3, T3
    Do While attemptCount < maxAttempts
        If IsEmpty(currentCell) Then
            Set FindEmptyCellWithInterval = currentCell
            Exit Function
        End If
        
        ' 向右移动2列（间隔1个单元格）
        Set currentCell = currentCell.Offset(0, 2)
        attemptCount = attemptCount + 1
    Loop
    
    ' 未找到空单元格
    Set FindEmptyCellWithInterval = Nothing
End Function

在模块中写方法类:

(1)FormatModuleArea,规范一个范围的单元格格式

' =============================================
' 方法名称：FormatCellRange
' 描述：设置单元格区域的字体、填充色和对齐方式
' 参数：targetRange - 要格式化的单元格区域
' =============================================
Public Sub FormatCellRange(ByVal targetRange As Range)
    On Error GoTo ErrorHandler
    
    ' 检查参数是否有效
    If targetRange Is Nothing Then
        MsgBox "错误：目标区域不能为空！", vbExclamation
        Exit Sub
    End 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 = xlCenter
    End With
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    
    ' 成功提示
    'MsgBox "区域格式化完成！共格式化 " & targetRange.Cells.Count & " 个单元格", vbInformation
    
    Exit Sub
    
ErrorHandler:
    ' 确保恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "格式化区域时出错：" & 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 Then
        MsgBox "错误：目标单元格不能为空！", vbExclamation
        Exit Sub
    End 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 = xlCenter
    End With
    
    ' 可选：设置测试文本
    'targetCell.Value = "格式化成功"
    
    Exit Sub
    
ErrorHandler:
    MsgBox "格式化单元格时出错：" & Err.Description, vbCritical
End Sub

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

' LC参考自AI
' 功能：提供单元格格式设置的通用函数

'设置红色填充格式
Public Sub ApplyRedFill(cell As Range)
    On Error GoTo ErrorHandler
    With cell.Interior
        .Color = RGB(255, 0, 0)    '红色
        .Pattern = xlSolid         '实心填充
        .TintAndShade = 0
    End With
    Exit Sub
ErrorHandler:
    MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub

'设置黄色填充格式
Public Sub ApplyYellowFill(cell As Range)
    On Error GoTo ErrorHandler
    With cell.Interior
        .Color = RGB(255, 255, 0)  '黄色
        .Pattern = xlSolid
        .TintAndShade = 0
    End With
    Exit Sub
ErrorHandler:
    MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub

'设置绿色填充格式
Public Sub ApplyGreenFill(cell As Range)
    On Error GoTo ErrorHandler
    With cell.Interior
        .Color = RGB(0, 255, 0)  '绿色
        .Pattern = xlSolid
        .TintAndShade = 0
    End With
    Exit Sub
ErrorHandler:
    MsgBox "设置格式时出错：" & Err.Description, vbExclamation
End Sub

'清除单元格填充格式
Public Sub ClearCellFill(cell As Range)
    On Error GoTo ErrorHandler
    cell.Interior.Pattern = xlNone  '无填充
    Exit Sub
ErrorHandler:
    MsgBox "清除格式时出错：" & Err.Description, vbExclamation
End Sub

'根据重要性设置格式的通用函数
Public Sub FormatByImportance(cell As Range, isValue As Boolean)
    If isValue Then
        ApplyGreenFill cell
    Else
        ApplyYellowFill cell
    End If
End Sub

三、相关知识

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

（1）HorizontalAlignment 属性

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

（3）运算符

（4）常用内置函数

四、个人感悟

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