VBA EXCEL 宏 - 在循環通過 target.cells 時更改單元格值

Question

語境：

我一直在努力在 Excel 上創建一個時間表，我想讓用戶在添加信息時讓一些事情變得更簡單。

每一天都分為白天和黑夜（法語中的“jour”和“nuit”：所以我使用“J”和“N”作為標識符）

我目前正在創建一個宏，當一個或多個單元格在某個范圍內（即計划中的一個單元格）發生更改時執行。 如果在單元格中輸入並提交了某些字符串代碼，我希望這些代碼的格式統一：大寫的代碼后跟小寫的“j”或“n”，具體取決於它是在白天還是晚上的列中輸入的。 （代碼是預定義的，但我不想使用不同代碼的下拉列表）

示例：如果用戶在日期列中鍵入“r”，則單元格值應更改為“Rj”。

如果用戶鍵入“rj”、“rn”、“RJ”……它仍應返回“Rj”。

因此，如果用戶已經有一個“Rj”單元格並將值向右拖動，它應該交替“Rj”和“Rn”

例外：如果用戶鍵入“x”，它應該只返回一個大寫的“X”

問題：

我為每個循環創建了一個循環，該循環遍歷目標單元格（如果用戶將數據拖到相鄰的列或行，則可以是一個或多個單元格）。 然而，即使只有一個單元格，似乎循環發生了多次，並且確實減慢了更改單元格數據的過程。

我試過同時使用 if 語句和 select 案例，看看它是否對效率產生了影響 - select 案例要快一點（盡管它要長得多），但它仍然需要很長時間。

我想知道這是否是我的計算機，但它是一台新近且功能強大的機器——所有其他編程都運行良好。

此外，即使滿足 a case 條件，Case Else 似乎仍然被執行......

我發現通過在大小寫字符串中添加空格有助於加快處理速度，因為如果一個單元格通過 for each 多次，因為它被分配了一個沒有空格的值，它不會對應於不同的情況。

您會在我的代碼末尾注意到，有些代碼不能在周末或晚上出現（由於 Case Else 問題，在 select 案例中進行了評論）。 如果這些需要更長的時間來執行，對我來說並不重要，但我不希望它減慢其他選項的速度。

時間表如下：

夜間/白天時間表

這是我的 vba 代碼的兩個版本：

    Select Case :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    'On Error GoTo done
    ' La variable KeyCells determine les cellules qui detectent le changement
    Set KeyCells = Range("T41:KC66")

If Not Application.Intersect(KeyCells, Target) Is Nothing Then
    Dim valeur As String
    For Each cell In Target
        valeur = UCase(cell.Value) & " "
        Select Case valeur
            Case "R "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "Rj"
                Else
                    cell.Value = "Rn"
                End If
            Case "Q "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "Qj"
                Else
                    cell.Value = "Qn"
                End If
            Case "SC1 "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "SC1j"
                Else
                    cell.Value = "SC1n"
                End If
            Case "SC2 "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "SC2j"
                Else
                    cell.Value = "SC2n"
                End If
            Case "MAO "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "MAOj"
                Else
                    cell.Value = "MAOn"
                End If
            Case "MUC "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "MUCj"
                Else
                    cell.Value = "MUCn"
                End If
            Case "UHC "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "UHCj"
                Else
                    cell.Value = "UHCn"
                End If
            Case "U "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "Uj"
                Else
                    cell.Value = "Un"
                End If
            Case "S "
                If ActiveSheet.Cells(40, cell.Column) = "J" Then
                    cell.Value = "Sj"
                Else
                    cell.Value = "Sn"
                End If
            Case "X "
                cell.Value = "X"

            'Case Else
                'MsgBox "hello"
                'if not cell.value = "R" or cell.
                'If valeur = "CA" Or valeur = "CM" Or valeur = "CLM" Or valeur = "CMD" Or valeur = "CET" Or valeur = "CF" Or valeur = "CP" Or valeur = "CG" Or valeur = "RTT" Or valeur = "ASA" Or valeur = "JR" Then
                   ' If ActiveSheet.Cells(37, cell.Column) = "sam" Or ActiveSheet.Cells(37, cell.Column) = "dim" Or ActiveSheet.Cells(40, cell.Column) = "N" Then
                    '    cell.Value = ""
                    'Else
                    '    cell.Value = valeur
                  '  End If
             '   ElseIf Left(valeur, 1) = "H" Then
              '      cell.Value = valeur
              '  End If
            End Select
    Next cell
End If

done:
End Sub

我刪除了額外的案例，例如案例“RJ”或“RN”，例如因為它很慢但確實想要我需要，它們需要被包括在內（而且因為它非常重復，你不需要查看所有案例） . 我還嘗試像這樣更改語法並添加 GoTo 以避免代碼中的冗余（但沒有幫助）：

Case "R ", "RJ ", "RN "

    If statements (seems much better but is much slower...):

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    'On Error GoTo done
' La variable KeyCells d_termine les cellules modifiables
    Set KeyCells = Range("T41:KC66")

If Not Application.Intersect(KeyCells, Target.Cells) Is Nothing Then
    'on parcourt toutes les cellules modifiées
    For Each cell In Target.Cells
    
        'si l'utilisatur entre une valeur de service valable et précise j ou n
        If Not IsError(Application.Match(cell.Value, Range("C73:C90"), 0)) Then
            'on s'assure que j ou n soit saisie correctement
            If ActiveSheet.Cells(40, cell.Column) = "J" Then
                service = UCase(Left(cell.Value, Len(cell.Value) - 1)) & "j"
                cell.Value = service
            Else
                service = UCase(Left(cell.Value, Len(cell.Value) - 1)) & "n"
                cell.Value = service
            End If
        
        'idem mais l'utilisateur n'a pas précisé le jour ou la nuit
        ElseIf Not IsError(Application.Match(cell.Value, Range("B73:B81"), 0)) Then
            If ActiveSheet.Cells(40, cell.Column) = "J" Then
                cell.Value = UCase(cell.Value) & "j"
            Else
                cell.Value = UCase(cell.Value) & "n"
            End If
        
        'si l'entrée correspond à un congé
        ElseIf Not IsError(Application.Match(cell.Value, Range("D73:D83"), 0)) Then
            If ActiveSheet.Cells(37, cell.Column) = "sam" Or ActiveSheet.Cells(37, cell.Column) = "dim" Or ActiveSheet.Cells(40, cell.Column) = "N" Then
                cell.Value = ""
            Else:
                cell.Value = UCase(cell.Value)
            End If

        End If
    Next cell
End If
done:
    Exit Sub
End Sub

這是我在第二個示例中用於代碼的單元格

帶有代碼的單元格

任何幫助都將不勝感激。 我希望這不是太多的信息，我不想錯過任何東西！

Answer 1

當您從事件處理程序更新工作表時，這將再次觸發事件，這可能導致無限循環或至少導致執行速度問題。 如果您要更新監控區域中的工作表，請使用Application.EnableEvents = False ，進行更改，然后將其設置回True （您必須這樣做，否則您的代碼將停止響應）。

非常輕微的測試：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range, jn As String, v, rngList As Range, m

    Set rng = Application.Intersect(Me.Range("T41:KC66"), Target)

    If Not rng Is Nothing Then
    
        On Error GoTo haveError
        Set rngList = Me.Range("C73:C90") 'list of codes to match on
        
        Application.EnableEvents = False
        For Each cell In rng.Cells
        
            v = UCase(Trim(cell.Value)) 'upper-case
            
            If Len(v) > 0 Then          'something was entered
                If Right(v, 1) = "J" Or Right(v, 1) = "N" Then
                    v = Left(v, Len(v) - 1) 'remove any trailing J or N
                End If
                
                If Len(v) > 0 Then
                    m = Application.Match(v, rngList, 0) 'in list? (case-insensitive)
                    If Not IsError(m) Then
                        jn = Me.Cells(40, cell.Column).Value           'day/night
                        cell.Value = rngList.Cells(m).Value & LCase(jn) 'matches case to list
                    Else
                        'what to do if no match?
                    End If
                Else
                    'what if user just enters j or n ?
                End If
            End If 'anything was entered
        
        Next cell
    End If

haveError:
    Application.EnableEvents = True
End Sub