Question

使用Excel 2013我想清除单元格H7，如果单元格H6更改为不同于Tractors的内容。单元格H6的值通过下拉列表设置。

如果我手动执行，下面的代码已经可以使用了。但是，我希望它在单元格H6更改时自动执行。

Sub CheckIt1()
  If Range("b6") <> "Tractors" Then Range("h7").ClearContents
End Sub

Sub CheckIt2()
  If Range("b9") <> "Tractors" Then Range("h10").ClearContents
End Sub

我有一系列10对需要在不符合条件时自动清除。

Answer 1

如果打开VB编辑器，屏幕左侧会显示如下内容：

-  VBAProject (xxxxxx.xlsm)
   -  Microsoft Excel Objects
      - Sheet1 (Sheet1)
      - Sheet2 (Sheet2)
      - Sheet3 (Sheet3)
      - ThisWorkbook
   -  Modules
        Module1 
        Module2

在屏幕上，这些缺点将在小框中。如果任何一个缺点是加号，请单击它以展开项目内容的该部分。

如果您重命名了工作表，则第一个“Sheet1”，“Sheet2”等将保持不变，因为工作表有Excel的永久名称，但第二个副本将被您的名称替换。如果您重命名了模块，“Module1”等将被您的名字替换。

单击“ThisWorkbook”，右侧的代码区域将清除。您可以在此代码区域中放置您希望的任何代码，但它主要用于工作簿级别的事件例程。

事件例程是Excel将在关联事件发生时执行的VBA代码。因此，在打开工作簿时将执行Sub Workbook_Open。

现在单击“SheetN（SheetN）”，其中SheetN是包含您要监视的单元格的工作表。再次，您将获得一个空代码区域。此代码区域与SheetN相关联。您将它用于仅与SheetN关联的事件例程。

将以下代码复制到代码区域。

我为你写了一个Worksheet_Change例行程序。每当SheetN中的单元格或范围或范围联合发生更改时，此例程将使用参数Range执行，该参数列出已更改的所有单元格和/或范围。对于其他工作表中的更改，不会执行此例程。

此例程的核心是以下三个数组：

CellsToMonitor = Array("B6", "B9", "B12", "B15")
ExpectedValue = Array("Tractors", "Tractors", "Tractors", "Tractors")
CellsToClear = Array("H7", "H10", "H13", "H16")

CellsToMonitor列出要监控的单元格。你的问题列出了B6和B9。我添加了几个单元用于测试目的。您可以根据需要在此列表中添加或减去。

您的问题意味着在每种情况下，预期值都是“拖拉机”。我已将期望值放在数组中，因此如果您愿意，可以使用不同的值。

CellsToClear列出要清除的单元格。

在事件例程中更详细地解释了所有这些。

我试图针对可能发生的每种类型的更改测试例程。您将需要使用例程来完全理解它是如何工作的，这样您最终可能会重复我的测试。如果有必要，请回答问题，但是，你能为自己解决的越多，你的发展就越快。

Private Sub Worksheet_Change(ByVal Target As Range)

  ' Target can be:
  '  * a single cell such as A1
  '  * a range such as A1:B2
  '  * a union of cells and ranges such as A1:B2, C3, D5

  ' Every cell in the range Target has been changed by the user or a macro.

  ' Stop the clearing of a cell from calling this routine
  Application.EnableEvents = False

  Dim CellsToMonitor As Variant
  Dim ExpectedValue As Variant
  Dim CellsToClear As Variant

  CellsToMonitor = Array("B6", "B9", "B12", "B15")
  ExpectedValue = Array("Tractors", "Tractors", "Tractors", "Tractors")
  CellsToClear = Array("H7", "H10", "H13", "H16")

  ' * CellsToMonitor is a list of cells within the worksheet that are to be monitored.
  '   The value of cells not in this list are not of interest.  The code assumes the
  '   column codes in this array are uppercase; so "B6" not "b6".
  ' * ExpectedValue is a list of the expected values for the cells to monitor. In the
  '   question all these values are the same.  This array allows the expected values
  '   to be different.
  ' * CellsToClear identifies the cell to be cleared if a monitored cell does not
  '   have the expected values.
  ' * The three arrays must have the same number of elements. If CellsToMonitor(N)
  '   is one of the cells in Target and if Range(CellsToMonitor(N)).Value is not
  '   equal to ExpectedValue(N) then Range(CellsToClear(N)) is cleared

  Dim ColCrnt As Long
  Dim InxMon As Long
  Dim InxTA As Long
  Dim RngCrnt As Range
  Dim RowCrnt As Long
  Dim TgtAddrPart() As String
  Dim TgtCellAddr As String
  Dim WshtTgt As Worksheet

  ' The cells within Target could have been changed by a macro so ActiveSheet
  ' does not have to be the worksheet being monitored.
  Set WshtTgt = Target.Worksheet

  TgtAddrPart = Split(Target.Address, ",")

  For InxTA = LBound(TgtAddrPart) To UBound(TgtAddrPart)

    Set RngCrnt = WshtTgt.Range(TgtAddrPart(InxTarget))

    ' RngCrnt.Row is the first row in the range
    ' RngCrnt.Rows.Count is the number of rows in the range.
    ' ColCrnt.Column and RngCrnt.Columns.Count are the same but for columns

    For RowCrnt = RngCrnt.Row To RngCrnt.Row + RngCrnt.Rows.Count - 1
      For ColCrnt = RngCrnt.Column To RngCrnt.Column + RngCrnt.Columns.Count - 1
        ' Debug.Print "Target cell = Cells(" & RowCrnt & ", " & ColCrnt & ")"

        ' Create A1 format address for current target cell
        TgtCellAddr = ColNumToCode(ColCrnt) & RowCrnt

        For InxMon = LBound(CellsToMonitor) To UBound(CellsToMonitor)
          If TgtCellAddr = CellsToMonitor(InxMon) Then
            ' Have match on address
            If WshtTgt.Cells(RowCrnt, ColCrnt).Value <> ExpectedValue(InxMon) Then
              ' Do not have match on expected value so clear linked cell
              WshtTgt.Range(CellsToClear(InxMon)).ClearContents
            End If
            Exit For
          End If
        Next  ' For each cell to monitor

      Next  ' For each column within Range within Target
    Next  ' For each row within Range within Target

  Next  ' For each Range within Target

  Application.EnableEvents = True

End Sub
Function ColNumToCode(ByVal ColNum As Long) As String

  Dim ColCode As String
  Dim PartNum As Long

  ' Last updated 3 Feb 12.  Adapted to handle three character codes.
  If ColNum = 0 Then
    ColNumToCode = "0"
  Else
    ColCode = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      ColCode = Chr(65 + PartNum) & ColCode
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

  ColNumToCode = ColCode

End Function

如果特定单元格更改，则自动执行代码

1 个答案: