基于另一列的单元格值自动填充单元格的VBA代码查询

Question

我正在写一张工作表，里面有客户和他们的车辆的记录。在车辆细节上，我有F栏，上面写着汽油车，G栏说它是柴油车。现在，我已经将数据验证放在这两列上，以显示Y和N。因此，客户可以选择Y或N。我想编写一个VBA代码，如果客户在F列(汽油车)中选择Y，则G列(柴油汽车)将自动为该客户取值N。如果客户为G列输入Y，则F列应自动变为N。

类似地，列H代表Petrocard，第一列代表Smartfleet。像上面一样，每次只有其中一个取值Y，另一个取值N。在这里，我还做了数据验证，给出了Y和N的下拉列表。

同样，列J代表两轮车，K列代表任何其他车辆。像上面一样，一次只有其中一个取值Y，另一个取值N。在这里，我还做了数据验证，给出了Y和N的下拉列表。

此外，在此工作表中，我已经为另一列C (Mobile )使用了VBA代码，以不允许excel表中的重复条目。

整个过程从M柱重复到R柱，从T柱重复到Y柱。

Answer 1

Luuk唱片的解决方案很容易实现，如果用户永远不会将“Y”放在错误的列中，那么它就能很好地工作。

考虑:用户在单元格F20中输入“Y”，单元格G20中的公式将显示“N”。然后，用户意识到他们犯了一个错误，并将“Y”输入到单元格G20中。单元格F20中的公式已被覆盖，因此将继续显示“Y”。

您需要一个Sheet_Change或Change event例程。

创建一个新的工作簿并打开Visual编辑器。在左边，你会看到这样的东西：

- VBAProject (Test.xlsm)
   - Microsoft Excel Objects
        Sheet1 (Sheet1)
        Sheet2 (Sheet2)
        Sheet3 (Sheet3)
        ThisWorkbook

如果任何一个连字符都是加号，请单击它以展开列表。

双击Sheet2 (Sheet2)以显示工作表“Sheet2”的代码区域。将以下内容复制到该代码区域：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

  Debug.Print Target.Address & "=" & Target.Value

End Sub

切换到Excel，并在每个工作表中输入几个值。切换回Visual，立即窗口将包含如下内容：

$E$4=a 
$E$7=b
$H$7=g
$H$4=h

您输入到“Sheet1”或“Sheet3”中的值都不会被记录。对于输入到“Sheet2”中的每个值。您将有一行显示已更改的单元格地址及其新值。

有一个类似的Workbook_SheetChange，它位于ThisWorkbook代码区域，它将记录所有工作表的更改，但我认为稍微简单一些的Worksheet_Change例程将足以满足您的需要。

使用Worksheet_Change例程，可以指定如果F列中的单元格变为“Y”，则G列中的匹配单元格变为“N”。反之亦然。

有两个复杂的问题：

• 对于Worksheet_Change，Target是一个范围，如果用户复制一个块，它可以包含多个单元格。我使用For Each CellCrnt In Target将一个区域分割成单独的单元格。
• 你有九对柱子。可以分别对每一对代码进行编码，但这将是大量的代码。我用了两个数组。第一个数组包含可能输入值的所有列，第二个数组包含匹配的列。我相信我已经正确地记录了你的列号，但是如果我有任何错误的话，它们很容易被改变。使用这样的数组意味着，只需向数组添加值，就可以添加更多的列对，而且列不必相邻。

试一试我的代码，必要时带着问题回来。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim CellCrnt As Range
  Dim ColCrnt As Long
  Dim ColsA As Variant
  Dim ColsB As Variant
  Dim Found As Boolean
  Dim InxCols As Long
  Dim RowCrnt As Long

  ColsA = Array(6, 8, 10, 13, 15, 17, 20, 22, 24, 7, 9, 11, 14, 16, 18, 21, 23, 25)
  ColsB = Array(7, 9, 11, 14, 16, 18, 21, 23, 25, 6, 8, 10, 13, 15, 17, 20, 22, 24)

  For Each CellCrnt In Target
    ColCrnt = CellCrnt.Column
    Found = False
    ' Look along ColsA for the column of the cell just changed
    For InxCols = LBound(ColsA) To UBound(ColsA)
      If ColsA(InxCols) = ColCrnt Then
        Found = True
        Exit For
      End If
    Next
    If Found Then
      ' The cell is within a controlled column
      If UCase(CellCrnt.Value) = "Y" Or UCase(CellCrnt.Value) = "N" Then
        RowCrnt = CellCrnt.Row
        ' Good value
        CellCrnt.Font.Color = RGB(0, 0, 0)  ' Set Black in case of earlier error
        With Cells(RowCrnt, ColsB(InxCols))
          .Font.Color = RGB(0, 0, 0)  ' Set Black in case of earlier error
          If UCase(CellCrnt.Value) = "Y" Then
            .Value = "N"
          Else
            .Value = "Y"
          End If
        End With
      Else
        ' Bad value
        CellCrnt.Font.Color = RGB(255, 0, 0)  ' Set Red to indicate error
      End If
    End If
  Next
End Sub