我怎样才能让这个 Excel VBA 为所有行运行，而不仅仅是第一行？

Question

对 VBA 如此陌生，几乎可以正常工作。我正在尝试重置一些数据验证列表，以便如果有人更改国家/地区选择，那么几个单元格将重置。例如，如果我选择 USA，那么我希望相应的 State 和 Shift 列显示“请选择...”，如果用户将国家/地区更改为 USA 以外的其他内容，则 State 列中不会显示任何内容，仅在班次列。我得到了这个工作，但它只在第一行运行。我不确定我的范围是否错误，或者我是否应该循环，这两者我完全一无所知。

Option Explicit

'The way this works is if the Payroll Country changes then the sub selections
'of State and Shift should reset based on if the country is USA

'Payroll Country = A column
'State = X column
'Shift = Y column

Private Sub Worksheet_Change(ByVal Target As Range)

    '"If Target.Count > 1 Then Exit Sub" is the VBA code to prevent an error if user highlights the range and deletes the data
    If Target.Count > 1 Then Exit Sub


            If Target.Address = "$A$6" And Target.Value = "USA" Then
                Range("X6").Value = "Please select..."
                Range("Z6").Value = "Please select..."
       
            ElseIf Target.Address = "$A$6" And Target.Value <> "USA" Then
                Range("X6").Value = ""
                Range("Z6").Value = "Please select..."
        
            End If

End Sub

Answer 1

试试这个：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.CountLarge > 1 Then Exit Sub 'CountLarge handles larger ranges...
    'check Target column and row...
    If Target.Column = 1 and Target.Row >= 6 Then 
        With Target.EntireRow
            .Columns("X").Value = IIf(Target.Value = "USA", _
                                     "Please select...", "")
            .Columns("Z").Value = "Please select..."
        End With
    End If
End Sub

Answer 2

工作表更改

• 如果您将Application.EnableEvents = False 行注释掉，您会注意到会有更多Debug.Print 行（USA 多行，non-USA 多两行），即在写入 (crg.Value = InitialString) 之后，代码再次调用自身（实际上工作表更改事件调用InitializeCountry 过程），但“幸运”在If irg Is Nothing Then Exit Sub 行之后退出，因为它正在写入非相交范围，但仍然再次调试打印Source Range Address , 在它继续Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0) 之前。这应该有助于您充分理解为什么需要禁用事件。
• 在完成测试后，注释或删除与Debug.Print 行相关的范围地址，因为它们会减慢代码速度。

表格模块，例如Sheet1

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    InitializeCountry Target
End Sub

标准模块，例如Module1

Option Explicit

Sub InitializeCountry( _
        ByVal Target As Range)
    
    ' Declare constants.
    
    Const SourceFirstCellAddress As String = "A6"
    Const StateColumn As String = "X"
    Const ShiftColumn As String = "Z"
    Const CriteriaString As String = "USA"
    Const InitialString As String = "Please select..."
    
    ' Read.
    
    Dim ws As Worksheet: Set ws = Target.Worksheet
    Dim sfCell As Range: Set sfCell = ws.Range(SourceFirstCellAddress)
    Dim srg As Range: Set srg = sfCell.Resize(ws.Rows.Count - sfCell.Row + 1)
    Debug.Print "Source Range Address:          " & srg.Address(0, 0)
        
    Dim irg As Range: Set irg = Intersect(srg, Target) ' Intersect Range
    If irg Is Nothing Then Exit Sub
    Debug.Print "Intersect Range Address:       " & irg.Address(0, 0)
    
    ' ShiftColumn
    Dim crg As Range ' Criteria Range
    Set crg = irg.EntireRow.Columns(ShiftColumn)
    Debug.Print "Criteria Range (ShiftColumn):  " & crg.Address(0, 0)
    
    ' StateColumn
    Dim erg As Range ' Empty Range
    Dim iCell As Range ' Current Intersect Cell
    For Each iCell In irg.Cells
        If iCell.Value = CriteriaString Then
            Set crg = Union(crg, iCell.EntireRow.Columns(StateColumn))
        Else
            If erg Is Nothing Then
                Set erg = iCell.EntireRow.Columns(StateColumn)
            Else
                Set erg = Union(erg, iCell.EntireRow.Columns(StateColumn))
            End If
        End If
    Next iCell
    
    ' Write.
    
    Application.ScreenUpdating = False
    ' This is crucial to not retrigger the event procedure when writing!
    Application.EnableEvents = False
    
    On Error GoTo ClearError
    
    crg.Value = InitialString
    Debug.Print "Criteria Range (Both Columns): " & crg.Address(0, 0)
    
    If Not erg Is Nothing Then
        erg.ClearContents ' erg.Value = Empty
        Debug.Print "Empty Range (StateColumn):     " & erg.Address(0, 0)
    End If
    
SafeExit:

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Exit Sub
    
ClearError:
    ' Don't uncomment this line!
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit

End Sub


' Test multi-range (only possible with VBA).
Sub InitializeCountryTEST()
    Dim rg As Range: Set rg = Range("A6:A20,A31:A50,A61:A100")
    rg.Value = "USA"
End Sub

' Debug.Print result for 'USA' (no 'Empty Range'):
'Source Range Address:          A6:A1048576
'Intersect Range Address:       A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn):   Z6:Z20
'Criteria Range (Both Columns): Z6:Z20,X6:X20,X31:X50,X61:X100

' Debug.Print result otherwise:
'Source Range Address:          A6:A1048576
'Intersect Range Address:       A6:A20,A31:A50,A61:A100
'Criteria Range(ShiftColumn):   Z6:Z20
'Criteria Range (Both Columns): Z6:Z20
'Empty Range (StateColumn):     X6:X20,X31:X50,X61:X100