Microsoft VBA Excel 一键写入和一键清除

项目场景

简述：
有一个输入数据的sheet，主要内容是工程场景、工程标记和编号的输入，在这个页面需要设计两个按钮，一个负责清除，一个负责更新（写入）。

具体实现过程：

1. 添加清除和更新的两个按钮
2. 编写清除和更新的两个宏
3. 分配宏到指定的两个按钮

---

细节展开

第一步：

1. 在Excel中，切换到名为“Run”的工作表。
2. 在Excel的“插入”选项卡下选择“形状”或“按钮”（也可以使用Excel的开发者选项卡——“控件”中的按钮）。
3. 在选中的位置绘制一个按钮。
4. 在弹出的“分配宏”对话框中，点击“新建”。这将打开VBA编辑器并创建一个新的宏与该按钮关联。

第二步：

1. 在名为Run的sheet中B2的位置循环输入数值，数值是从D4位置开始读取，直到出现空值停止读取。
2. 每次循环，首先需要判断F列的值是否是"是"（例如第一次循环是D4，那么需要判断对应的F4是否是"是"）；第二，需要重新计算名为working的sheet上的全部公式（也就是刷新working这个工作表）；第三，找到与E列对应位置名称一致的sheet（例如第一次循环是D4，那么对应名称就在E4，然后去找和这个名称一致的sheet），把working整个sheet的值复制到其中，如果没有找到一样的sheet，循环仍能够进行，就需要在最后警告框提示有哪几个序号和名称没有与之对应的sheet。
3. 设计一个清除键，读取E列全部的sheet名称，判断是否F列的对应位置为"是"，如果满足条件则清空对应sheet的除标题以外的全部数据（换句话说就是筛选F列为"是"的所有行，读取E列对应的单元格，把单元格内对应sheet名称的除标题以外的全部数据）。

详解：

    Set wsRun = ThisWorkbook.Sheets("Run")
    Set wsWorking = ThisWorkbook.Sheets("Working")
    notFoundSheets = ""

Set 关键字在VBA中用于分配对象引用给变量，在这里它用于将名为 “Run” 的工作表对象分配给 wsRun 变量。ThisWorkbook 是一个VBA对象，它引用包含执行代码的当前工作簿。Sheets("Run") 是获取工作簿中名为 “Run” 的工作表的方法。

声明了一个名为 notFoundSheets 的变量，并初始化为空字符串 ("")。在代码的后续部分，这个变量会被用来存储那些在循环过程中没有找到对应工作表名称的字符串。每当代码尝试查找E列提到的工作表而失败时，就会将其名称和行号添加到 notFoundSheets 字符串中。这样，最后可以通过一个警告框来提示用户哪些工作表没有找到。

总的来说，创建一个引用当前工作簿中 “Run” 工作表的变量 wsRun和把名为 “Working” 的工作表对象分配给 wsWorking 变量；初始化 notFoundSheets 变量。

' 循环D列的值
For Each cell In wsRun.Range("D4", wsRun.Range("D4").End(xlDown))
    value = cell.Value
    If value = "" Then Exit For
    If cell.Offset(0, 2).Value = "是" Then ' 检查F列是否为"是"
        wsRun.Range("B2").Value = value
        wsWorking.Calculate ' 刷新working表

• cell 是循环中使用的变量，代表当前正在处理的单元格。
• 循环的范围：从工作表 wsRun 上的 D4 单元格开始，直到该列最后一个非空单元格（xlDown是Excel VBA中的一个枚举，表示向下）,简单来说，它类似于在Excel中按下Ctrl+向下箭头键的操作。。
• value = cell.Value是将当前循环单元格的值赋给变量 value。
• If value = "" Then Exit For: 这是一个条件判断，它检查 value 是否为空字符串（即当前单元格是否为空）。如果为空，则执行 Exit For，这会立即终止循环。
• cell.Offset(0, 2) 返回一个单元格的引用，这个单元格位于当前 cell（D列中的单元格）的同一行，但是在它右边第二列（即F列）。
• wsWorking.Calculate: 这行代码用来刷新或重新计算名为Working的工作表上的所有公式。这实际上是模拟了用户按下F9键的操作，确保所有的公式都基于新的数据重新计算，保证了数据的更新。

            ' 检查E列对应的工作表是否存在
            sheetName = cell.Offset(0, 1).Value
            On Error Resume Next
            Set targetSheet = ThisWorkbook.Sheets(sheetName)
            isSheetFound = Not targetSheet Is Nothing
            On Error GoTo 0
            
            If isSheetFound Then
                ' 如果存在则复制working表的内容到目标表
                wsWorking.Cells.Copy
                With targetSheet.Cells
                    .PasteSpecial Paste:=xlPasteValues
                    .PasteSpecial Paste:=xlPasteFormats
                    Application.CutCopyMode = False
                End With
            Else
                ' 如果没有找到sheet，记录下来
                notFoundSheets = notFoundSheets & cell.Row & " (" & sheetName & "), "
            End If
            
            Set targetSheet = Nothing

• cell.Offset(0, 1).Value 获取当前循环中D列单元格相邻的E列单元格的值，这个值假设为工作表的名称，并将其赋给变量sheetName。
• On Error Resume Next 是一个错误处理的语句，它告诉VBA如果遇到错误就忽略它，并继续执行下一行代码（将sheetName对应的工作表设置给变量targetSheet）。这在尝试访问可能不存在的工作表时很有用，因为如果工作表不存在，尝试设置它会产生错误。
• Not targetSheet Is Nothing 检查变量targetSheet是否已成功设置为一个工作表对象。如果targetSheet不是Nothing，这意味着工作表存在，isSheetFound将被设为True。
• notFoundSheets 是一个字符串变量，用来累加所有未找到工作表的信息。这里通过连接字符串的方式，将当前循环的行号cell.Row和工作表名称sheetName添加到这个字符串中，每个条目之间用逗号隔开。
• On Error GoTo 0 将错误处理重置为默认状态，这意味着在这之后的代码中如果发生错误，程序将不再忽略错误，而是会停止执行并显示一个错误消息。
• • wsWorking.Cells.Copy 将名为Working的工作表中所有单元格的内容复制到剪贴板。
• With targetSheet.Cells 语句块开始，在这个块内部，我们处理之前找到的工作表targetSheet的单元格。
• .PasteSpecial Paste:=xlPasteValues 将复制的值粘贴到targetSheet的单元格中，不包括公式，只是值。
• .PasteSpecial Paste:=xlPasteFormats 接着将复制的单元格格式粘贴到targetSheet的单元格中。
• Application.CutCopyMode = False 关闭剪贴板，这是一个用来清除剪贴板的好方法，它也防止了之后的粘贴操作。
• 将变量targetSheet重置为Nothing可以帮助释放内存中的对象。

---

总结

Sub Button_Click()
    Dim wsRun, wsWorking, targetSheet As Worksheet
    Dim cell As Range
    Dim value As Variant
    Dim sheetName As String
    Dim notFoundSheets As String
    Dim isSheetFound As Boolean
    
    Set wsRun = ThisWorkbook.Sheets("Run")
    Set wsWorking = ThisWorkbook.Sheets("Working")
    notFoundSheets = ""
    
    ' 循环D列的值
    For Each cell In wsRun.Range("D4", wsRun.Range("D4").End(xlDown))
        value = cell.Value
        If value = "" Then Exit For
        If cell.Offset(0, 2).Value = "是" Then ' 检查F列是否为"是"
            wsRun.Range("B2").Value = value
            wsWorking.Calculate ' 刷新working表
            
            ' 检查E列对应的工作表是否存在
            sheetName = cell.Offset(0, 1).Value
            On Error Resume Next
            Set targetSheet = ThisWorkbook.Sheets(sheetName)
            isSheetFound = Not targetSheet Is Nothing
            On Error GoTo 0
            
            If isSheetFound Then
                ' 如果存在则复制working表的内容到目标表
                wsWorking.Cells.Copy
                With targetSheet.Cells
                    .PasteSpecial Paste:=xlPasteValues
                    .PasteSpecial Paste:=xlPasteFormats
                    Application.CutCopyMode = False
                End With
            Else
                ' 如果没有找到sheet，记录下来
                notFoundSheets = notFoundSheets & cell.Row & " (" & sheetName & "), "
            End If
            
            Set targetSheet = Nothing
        End If
    Next cell
    
    ' 如果有未找到的sheet，显示警告信息
    If notFoundSheets <> "" Then
        notFoundSheets = Left(notFoundSheets, Len(notFoundSheets) - 2) ' 移除最后的逗号和空格
        MsgBox "These sheets can not be found: " & notFoundSheets
    End If
End Sub

Sub ClearDataBelowHeaders()
    Dim wsRun, wsTarget As Worksheet
    Dim cell As Range
    
    Set wsRun = ThisWorkbook.Sheets("Run")
    
    ' 循环E列的值
    For Each cell In wsRun.Range("E4", wsRun.Range("E4").End(xlDown))
        ' 判断同一行的F列的值是否为"是"
        If wsRun.Cells(cell.Row, "F").Value = "是" Then
            ' 如果是"是"，处理工作表
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets(cell.Value)
            On Error GoTo 0
            
            If Not wsTargt Is Nothing Then
                ' 清除目标表的内容（除了标题）
                wsTarget.Rows("2:" & wsTarget.Rows.Count).ClearContents
                Set targetSheet = Nothing ' 重置目标工作表变量
            End If
        End If
    Next cell
End Sub