自动更新具有从属下拉值的单元格



我有一个工作表,其中有两列(列C和列E)。列E有下拉菜单的单元格,这些单元格依赖于同一行,列C中的单元格的值。

我试图让在E列的值自动更改为新的相应的下拉菜单的第一个选项时,在C列的值变化。目前,当C列中的值发生变化时,各自E列单元格中之前的值保持不变,我必须手动单击并从新列表中进行选择。

我必须这样开始:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1) As Range, rng1 As Range
Set rng(0) = Range("C71:C91")
Set rng(1) = Range("E71:E91")
Application.EnableEvents = False
If Not Intersect(Target, rng(0)) Is Nothing Then
For Each rng1 In rng(1)
i = i + 1
rng1 = Range("" & rng(0).Value2)(i, 1)
Next
End If
Application.EnableEvents = True
End Sub

还没有完全测试代码,但可以看到一个基本的错误。线:

For Each rng1 In rng(1)

应该读:

For Each rng1 In rng(1).Cells

在if语句后重新计算Application.CalculateFull

带数据验证的工作表更改

  • 假设E71:E91中的下拉框"获取"C71:C91的值,并且当您更改(手动或通过VBA)C71:C91中的值时,E71:E91同一行中的值将被此值覆盖。
  • 当完成测试时,注释或删除Debug.Print行。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print "Worksheet Change Sequence at " & Now
Debug.Print "1. '" & Target.Address(0, 0) & "' has changed."
Dim srg As Range: Set srg = Range("C71:C91")
Dim drg As Range: Set drg = Range("E71:E91")
Dim irg As Range: Set irg = Intersect(srg, Target)
Debug.Print "2. Range references created."

If irg Is Nothing Then
Debug.Print "3. No intersecting range. Exiting."
Exit Sub
Else
Debug.Print "3. Intersecting range at '" & irg.Address(0, 0) & "'."
End If

On Error GoTo ClearError
Application.EnableEvents = False
Debug.Print "4. Error handler activated. Events disabled."

' Write to intersecting rows only.
Dim dCol As Long: dCol = drg.Column
Dim iCell As Range
For Each iCell In irg.Cells
iCell.EntireRow.Columns(dCol).Value = iCell.Value
Next iCell
Debug.Print "5. Written to '" _
& Intersect(irg.EntireRow, drg).Address(0, 0) & "'."
'Or:
' Write to whole destination range.
'drg.Value = srg.Value
'Debug.Print "5. Written to '" & drg.Address(0, 0) & "'."
SafeExit:
Application.EnableEvents = True
Debug.Print "6. Events enabled. Exiting."
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
' Multi-range example. Best run from 'VBE' with the Immediate window open.
Sub Test()
Range("C71,C73,C75").Value = "A"
Range("C73,C75").Value = "B"
Range("C75").Value = "C"
End Sub

最新更新