更新单元格时，自动更新行中匹配的单元格

Question

我想在某些列中提供预先设置的选项时，验证的项目被选中。例如，当选择“液体/局部/其他”时，我希望它自动在与药丸数量相关的特定列中放置N/A。

我认为可能有一种更有效的方法--也许使用"Offset"？我不是很熟练地使用偏移，所以任何帮助都是感激的！

“药丸或液体/外用/其他”是D栏“如果液体/外用/其他，估计剩余量”是E栏“每天给药的总数(乘以每剂量的药丸数×给药次数)”是F栏“剩余药丸的数量”是G栏。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range


    Set KeyCells = Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then


If Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]") = "Pill" Then
Sheets("MedicationCounts").Range("Table1[If Liquid/Topical/Other, estimated amount remaining]") = "N/A"
ElseIf Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]") = "Liquid/topical/other" Then

Sheets("MedicationCounts").Range("Table1[Total number of pills administered daily (multiply # of pills per dose x # of administration times)]") = "N/A"
Sheets("MedicationCounts").Range("Table1[Number Of Pills Remaining]") = "N/A"
Sheets("MedicationCounts").Range("Table1[Number Of Days Remaining]") = "N/A"

End If

End If
End Sub

Answer 1

因为您的数据在ListObject (Table1)中，所以我们不需要使用Offset，并且可以使用表中的标题或列号来引用范围。

我同意@Cyril的观点，即Select Case语句也会看起来更干净，并有助于更清晰地呈现选项。

Private Sub Worksheet_Change(ByVal Target As Range)
    'Save a reference to "Table1"
    Dim Tbl As ListObject
    Set Tbl = Me.ListObjects("Table1")
    
    'Save the column numbers of the important columns in Table1
    'These can be written using header names or column numbers like ListColumns("Name") or ListColumns(#)
    Dim TblCols() As Variant
    TblCols = Array( _
                Tbl.ListColumns("If Liquid/Topical/Other, estimated amount remaining").Range.Column, _
                Tbl.ListColumns("Total number of pills administered daily (multiply # of pills per dose x # of administration times)").Range.Column, _
                Tbl.ListColumns("Number Of Pills Remaining").Range.Column, _
                Tbl.ListColumns("Number Of Days Remaining").Range.Column _
              )
    
    'Save a reference to the watched range
    Dim KeyCells As Range
    Set KeyCells = Tbl.ListColumns("Pill Or Liquid/topical/other").Range
    
    'Check if Target overlaps with KeyCells
    Dim RelevantRange As Range
    Set RelevantRange = Application.Intersect(KeyCells, Target)
    
    'If there are overlapping cells
    If Not RelevantRange Is Nothing Then
        Application.EnableEvents = False

        Dim Cell As Range
        'For each overlapping cell
        For Each Cell In RelevantRange.Cells
            Select Case LCase(Trim(Cell.Value)) 'more flexible string matching with lcase & trim
                Case "pill"
                    Me.Cells(Cell.Row, TblCols(0)).Value = "N/A"
                Case "liquid/topical/other"
                    Me.Cells(Cell.Row, TblCols(1)).Value = "N/A"
                    Me.Cells(Cell.Row, TblCols(2)).Value = "N/A"
                    Me.Cells(Cell.Row, TblCols(3)).Value = "N/A"
            End Select
        Next
        Application.EnableEvents = True
    End If
End Sub

如果以上情况令人困惑，或者组织风格不适合您，另一种选择可以是：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Save a reference to "Table1"
    Dim Tbl As ListObject
    Set Tbl = Me.ListObjects("Table1")
    
    'Save a reference to the watched range
    Dim KeyCells As Range
    Set KeyCells = Tbl.ListColumns("Pill Or Liquid/topical/other").Range
    
    'Check if Target overlaps with KeyCells
    Dim RelevantRange As Range
    Set RelevantRange = Application.Intersect(KeyCells, Target)
    
    'If there are overlapping cells
    If Not RelevantRange Is Nothing Then
        Application.EnableEvents = False

        Dim Cell As Range
        'For each overlapping cell
        For Each Cell In RelevantRange.Cells
            With Cell.EntireRow
                Select Case LCase(Trim(Cell.Value)) 'more flexible string matching with lcase & trim
                    Case "pill"
                        .Cells(Tbl.ListColumns("If Liquid/Topical/Other, estimated amount remaining").Range.Column).Value = "N/A"
                    Case "liquid/topical/other"
                        .Cells(Tbl.ListColumns("Total number of pills administered daily (multiply # of pills per dose x # of administration times)").Range.Column).Value = "N/A"
                        .Cells(Tbl.ListColumns("Number Of Pills Remaining").Range.Column).Value = "N/A"
                        .Cells(Tbl.ListColumns("Number Of Days Remaining").Range.Column).Value = "N/A"
                End Select
            End With
        Next
        Application.EnableEvents = True
    End If
End Sub

第二个更接近于你目前所拥有的。

我几乎忘了Application.EnableEvents。在Worksheet_Change事件期间进行工作表更改时，关闭事件非常重要，否则可能会陷入循环。在这个脚本中，它不会循环，但仍然会浪费时间。