如何使用更改事件計算公式並將值插入各個單元格

Question

我在以下問題中尋求有關代碼的幫助：

根據匹配項旁邊的單元格中的下拉列表插入值

在@Variatus 的巨大努力下，他幫助我找到了解決方案，我有工作代碼“根據匹配的單元格旁邊的下拉列表插入值”，這兩種方式都有效。 當我試圖深入研究代碼時，我試圖弄清楚如何使用Worksheet_Change進行公式計算。 我想避免復雜的代碼，所以我用下拉列表值檢查列“D”，當它被更改時，列“E”中的計算公式值被復制到下一個表中的匹配單元格。 一切都像我的“Sheet1”上的魅力一樣。 但是當我試圖將代碼復制到我的“Sheet2”時，即使我沒有更改任何內容，它也會停止以這種方式工作。 也許我錯過了一些東西，但我無法弄清楚它是什么。 我嘗試從頭開始，但仍然沒有。

這里有兩個“Sheet1”和“Sheet2”的PrtScns：

表 1

表 2

這是我用於 Sheet1 的代碼，它沒有問題：

Option Explicit

Enum Nws                    ' worksheet where 'Data' values are used
    ' 060-2
    NwsFirstDataRow = 10     ' change to suit
    NwsTrigger = 8           ' Trigger column (5 = column E)
    NwsTarget = 10           ' Target column (no value = previous + 1)
End Enum

Enum Nta                    ' columns of range 'Data'
    ' 060
    NtaId = 1               ' 1st column of 'Data' range
    NtaVal = 4              ' 3rd column of 'Data' range
End Enum

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 060-2
    
    Dim Rng         As Range
    Dim Tmp         As Variant
    
    ' skip action if more than 1 cell was changed
    If Target.CountLarge > 1 Then Exit Sub
    
    Set Rng = Range(Cells(NwsFirstDataRow, NwsTrigger), _
                    Cells(Rows.Count, NwsTrigger).End(xlUp))
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        With Application
            Tmp = .VLookup(Target.Value, Range("Data"), NtaVal, False)
            If Not IsError(Tmp) Then
                .EnableEvents = False       ' suppress 'Change' event
                Cells(Target.Row, NwsTarget).Value = Tmp
                .EnableEvents = True
            End If
        End With
    Else
        Set Rng = Range("B2:E4")             ' change to suit
        If Not Application.Intersect(Target, Rng.Columns(NtaVal - 1)) Is Nothing Then
'        If Not Application.Intersect(Target, Range("D2:D4")) Is Nothing Then
            UpdateCategory Cells(Target.Row, Rng.Column).Resize(1, NtaVal).Value
        End If
    End If
End Sub
    
Private Sub Worksheet_activate()
    ' 060-2
    
    Dim TgtWs           As Worksheet        ' the Tab on which 'Data' was used
    Dim Cat             As Variant          ' 'Data' category (2 cells as Nta)
    Dim R               As Long             ' loop counter: rows
    Set TgtWs = Sheet1                      ' change to match your facts
    
    With Range("Data")                      ' change to match your facts
        For R = 1 To .Rows.Count
            Cat = .Rows(R).Value
            UpdateCategory Cat
        Next R
    End With
End Sub

Private Sub UpdateCategory(Cat As Variant)
    ' 060-2
    
    Dim Fnd             As Range            ' matching cell
    Dim FirstFound      As Long             ' row of first match
    Dim Rng             As Range
    
    Application.EnableEvents = False
    Set Rng = Range(Cells(NwsFirstDataRow, NwsTrigger), _
                     Cells(Rows.Count, NwsTrigger).End(xlUp))
    With Rng
         Set Fnd = .Find(Cat(1, NtaId), LookIn:=xlValues, LookAt:=xlWhole)
         If Not Fnd Is Nothing Then
            FirstFound = Fnd.Row
            Do
                Cells(Fnd.Row, NwsTarget).Value = Cat(1, NtaVal)
                Set Fnd = .FindNext(Fnd)
                If Fnd Is Nothing Then Exit Do
            Loop While Fnd.Row <> FirstFound
        End If
    End With
    Application.EnableEvents = True
End Sub

而 Sheet2 的代碼沒有：

Option Explicit

Enum Nws1                    ' worksheet where 'Data1' values are used
    ' 060-2
    Nws1FirstData1Row = 16     ' change to suit
    Nws1Trigger = 18          ' Trigger column (5 = column E)
    Nws1Target = 20            ' Target column (no value = previous + 1)
End Enum

Enum Nta1                    ' columns of range 'Data1'
    ' 060
    Nta1Id = 1               ' 1st column of 'Data1' range
    Nta1Val = 5              ' 3rd column of 'Data1' range
End Enum

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 060-2
    
    Dim Rng         As Range
    Dim Tmp         As Variant
    
    ' skip action if more than 1 cell was changed
    If Target.CountLarge > 1 Then Exit Sub
    
    Set Rng = Range(Cells(Nws1FirstData1Row, Nws1Trigger), _
                    Cells(Rows.Count, Nws1Trigger).End(xlUp))
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        With Application
            Tmp = .VLookup(Target.Value, Range("Data1"), Nta1Val, False)
            If Not IsError(Tmp) Then
                .EnableEvents = False       ' suppress 'Change' event
                Cells(Target.Row, Nws1Target).Value = Tmp
                .EnableEvents = True
            End If
        End With
    Else
        Set Rng = Range("M19:M25")             ' change to suit
        If Not Application.Intersect(Target, Rng.Columns(Nta1Val - 2)) Is Nothing Then
        UpdateCategory Cells(Target.Row, Rng.Column).Resize(1, Nta1Val).Value
        End If
    End If
End Sub
    
Private Sub Worksheet_activate()
    ' 060-2
    
    Dim TgtWs           As Worksheet        ' the Tab on which 'Data1' was used
    Dim Cat             As Variant          ' 'Data1' category (2 cells as Nta1)
    Dim R               As Long             ' loop counter: rows
    Set TgtWs = Sheet2                      ' change to match your facts
    
    With Range("Data1")                      ' change to match your facts
        For R = 1 To .Rows.Count
            Cat = .Rows(R).Value
            UpdateCategory Cat
        Next R
    End With
End Sub

Private Sub UpdateCategory(Cat As Variant)
    ' 060-2
    
    Dim Fnd             As Range            ' matching cell
    Dim FirstFound      As Long             ' row of first match
    Dim Rng             As Range
    
    Application.EnableEvents = False
    Set Rng = Range(Cells(Nws1FirstData1Row, Nws1Trigger), _
                     Cells(Rows.Count, Nws1Trigger).End(xlUp))
    With Rng
         Set Fnd = .Find(Cat(1, Nta1Id), LookIn:=xlValues, LookAt:=xlWhole)
         If Not Fnd Is Nothing Then
            FirstFound = Fnd.Row
            Do
                Cells(Fnd.Row, Nws1Target).Value = Cat(1, Nta1Val)
                Set Fnd = .FindNext(Fnd)
                If Fnd Is Nothing Then Exit Do
            Loop While Fnd.Row <> FirstFound
        End If
    End With
    Application.EnableEvents = True
End Sub

任何幫助將不勝感激！

Answer 1

這是原始代碼的摘錄。

Set Rng = Range("Data")             ' change to suit
If Not Application.Intersect(Target, Rng.Columns(NtaVal)) Is Nothing Then
    UpdateCategory Cells(Target.Row, Rng.Column).Resize(1, NtaVal).Value
End If

下面是 Sheet1 后面代碼中的相應部分。

Set Rng = Range("B2:E4")             ' change to suit
If Not Application.Intersect(Target, Rng.Columns(NtaVal - 1)) Is Nothing Then
    UpdateCategory Cells(Target.Row, Rng.Column).Resize(1, NtaVal).Value
End If

這是與 Sheet2 后面的代碼完全相同的部分。

Set Rng = Range("M19:M25")             ' change to suit
If Not Application.Intersect(Target, Rng.Columns(Nta1Val - 2)) Is Nothing Then
UpdateCategory Cells(Target.Row, Rng.Column).Resize(1, Nta1Val).Value
End If

現在你可以分析發生了什么。

1. Data范圍是按名稱聲明的，以減輕您多次檢查地址的苦差事。 您在工作表上需要它，在代碼中也需要它。 您設置一次，無論您使用該名稱，它都是正確的。
2. 在您自己呈現的相同代碼中，您將名稱更改為工作表地址： Range("B2:E4") 。 確實沒有區別，只是您必須檢查以確保 Range("B2:E4") 確實與Data相同。 這是額外的工作，但它有效。
3. 使用Set Rng = Range("M19:M25")你走進了你為自己設置的陷阱。 根據您的設計，這應該是命名范圍Data1 。 但事實並非如此。 Data1有 5 列，而您在其位置聲明的范圍只有 1。

從上面的分析很清楚你是通過什么邏輯得出錯誤的。 您沒有“擁有”命名范圍。 因此，您努力將其替換為坐標。 在此過程中，您放棄了使用命名變量帶來的安全性，然后在您承擔額外風險時未能進行所需的額外檢查。

請注意在 Sheet2 的代碼中UpdateCategory Cells(Target...行的缺失意圖。縮進用於顯示 IF 語句的開頭和結尾。人們期望初學者在閱讀代碼時需要更多這樣的幫助而不是專家。然而事實是所有初學者（包括你的好自我）都認為它沒有區別，實際上並沒有，但是更高級的程序員知道他們需要清晰高於一切。你可以從他在代碼中應用的縮進。這是一個非常可靠的指標。