当我更改单元格中的值时，我无法自动触发宏。该宏应该在多个范围内更新货币值，但只有在更改值后手动运行它才有效。 这是我正在使用的代码：
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if U1 is changed
If Not Intersect(Target, Me.Range("U1")) Is Nothing Then
' Run the UpdateValues procedure when U1 changes
UpdateValues
End If
End Sub
Sub UpdateValues()
Dim ws As Worksheet
Dim currencySheet As Worksheet
Dim u1Value As Integer
Dim newConversionRate As Double
Dim cell As Range
Dim actualConversionRate As Double
Dim rangesToConvert As Variant
Dim i As Integer
' Set references to the sheets
Set ws = ThisWorkbook.Sheets("August") ' Your main sheet
Set currencySheet = ThisWorkbook.Sheets("Currencies") ' Currency rates sheet
' Get the value of U1 (the selected conversion option)
u1Value = ws.Range("U1").Value
' Ensure U1 value is valid
If u1Value < 1 Or u1Value > 5 Then
Exit Sub ' Exit without doing anything if U1 is not valid
End If
' Get the new conversion rate from the Currencies sheet
newConversionRate = currencySheet.Cells(u1Value + 1, 2).Value ' Currencies!B2 to B6 based on U1 value
' Get the previous conversion rate from A1
actualConversionRate = ws.Range("A1").Value
' If the previous conversion rate is 0, set it to 1 to avoid division by zero
If actualConversionRate = 0 Then
actualConversionRate = 1
End If
' Define the ranges to convert
rangesToConvert = Array("B3:AG22", "B24:AG39", "B41:AG48", "B50:AG56", "B58:AG65", "B67:AG77", "B79:AG86", _
"B88:AG101", "B103:AG114", "B116:AG121", "B123:AG131", "B133:AG138", "B140:AG141")
' Loop through each defined range and update the values
For i = LBound(rangesToConvert) To UBound(rangesToConvert)
Set rangeToConvert = ws.Range(rangesToConvert(i))
For Each cell In rangeToConvert
' Check if the cell value is numeric and not empty
If IsNumeric(cell.Value) And Not IsEmpty(cell.Value) Then
' Divide by the previous conversion rate and then multiply by the new conversion rate
cell.Value = (cell.Value / actualConversionRate) * newConversionRate
End If
Next cell
Next i
' Update the previous conversion rate in A1 to the new conversion rate
ws.Range("A1").Value = newConversionRate
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
宏的目标是检测 U1 何时发生变化并立即更新值，但由于某种原因，它不会触发。
以前有人遇到过这个问题吗？关于如何使其在 U1 更改时自动更新有什么想法吗？将不胜感激任何见解！
我尝试了不同的解决方案，但似乎都不起作用。我可能在我的设置中遗漏了一些东西。
工作表模块，例如
AugustPrivate Sub Worksheet_Change(ByVal Target As Range)
UpdateValues Target
End Sub
标准模块，例如
Module1Sub UpdateValues(ByVal Target As Range)
' Implement an error-handling routine to ensure events get enabled
' if an error occurs.
Dim MsgString As String
On Error GoTo ClearError ' start error-handling routine
' Define constants.
Const TARGET_CELL_ADDRESS As String = "U1"
Const TARGET_RATE_CELL_ADDRESS As String = "A1"
Const LOOKUP_SHEET_NAME As String = "Currencies"
Const LOOKUP_COLUMN As String = "B"
Const MIN_VALUE As Long = 1
Const MAX_VALUE As Long = 5
Dim RANGES_TO_CONVERT() As Variant: RANGES_TO_CONVERT = Array( _
"B3:AG22", "B24:AG39", "B41:AG48", "B50:AG56", "B58:AG65", _
"B67:AG77", "B79:AG86", "B88:AG101", "B103:AG114", "B116:AG121", _
"B123:AG131", "B133:AG138", "B140:AG141")
' Reference the target sheet and cell.
Dim tws As Worksheet: Set tws = Target.Worksheet
Dim tcell As Range: Set tcell = tws.Range(TARGET_CELL_ADDRESS)
' Exit if the target cell was not changed.
If Intersect(tcell, Target) Is Nothing Then Exit Sub
' Reference the lookup sheet (
Dim lws As Worksheet: Set lws = ThisWorkbook.Sheets(LOOKUP_SHEET_NAME)
' Get the value of cell 'U1' (the selected conversion option).
Dim Value As Variant: Value = tcell.Value
' Exit if the value is 'invalid'.
If Not IsNumeric(Value) Then Exit Sub ' not a number
If Value < MIN_VALUE Or Value > MAX_VALUE Then Exit Sub ' out of bounds
If Int(Value) <> Value Then Exit Sub ' not an integer
' Get the new conversion rate from the Currencies sheet
' of cell 'B2' To 'B6' (1 To 5) based on target cell.
Dim NewRate As Double: NewRate = lws.Cells(Value + 1, LOOKUP_COLUMN).Value
' Get the previous conversion rate from cell 'A1'.
Dim OldRate As Double: OldRate = tws.Range(TARGET_RATE_CELL_ADDRESS).Value
' If the previous conversion rate is 0, set it to 1
' to avoid division by zero.
If OldRate = 0 Then OldRate = 1
' Always disable events before writing to the target sheet
' to prevent retriggering this event (and triggering any other events)!
Application.EnableEvents = False
' Declare additional variables.
Dim rg As Range, cell As Range, i As Long
' Loop through each defined range and update the values.
For i = LBound(RANGES_TO_CONVERT) To UBound(RANGES_TO_CONVERT)
Set rg = tws.Range(RANGES_TO_CONVERT(i))
' Loop through each cell of current range.
For Each cell In rg.Cells
Value = cell.Value ' read
' Check if the cell contains a number.
If VarType(Value) = vbDouble Then ' is number
' Divide by the old conversion rate
' and multiply by the new conversion rate.
cell.Value = (Value / OldRate) * NewRate
End If
Next cell
Next i
' Update the previous to the new conversion rate in cell 'A1'.
tws.Range(TARGET_RATE_CELL_ADDRESS).Value = NewRate
ProcExit:
' Prevent endless loop if error in continuation.
On Error Resume Next ' defer error trapping
Application.EnableEvents = True ' enable events ('at all cost!')
If Len(MsgString) > 0 Then MsgBox MsgString, vbCritical
On Error GoTo 0 ' enable error trapping (default)
Exit Sub
ClearError: ' continue error-handling routine
MsgString = "Runtime error [" & Err.Number & "]:" & vbLf & vbLf _
& Err.Description
Resume ProcExit ' redirect error-handling routine
End Sub