VBA EXCEL MACRO - 在循环遍历 target.cells

问题描述

背景：

我一直致力于在 Excel 上创建日程表，我想让用户在添加信息时做一些更简单的事情。

每天分为白天和黑夜（法语中的“jour”和“nuit”：所以我使用“J”和“N”作为标识符）

我目前正在创建一个宏，当一个或多个单元格在某个范围内（即计划中的一个单元格）发生更改时，该宏会执行。如果在单元格中键入并提交某些字符串代码，我希望这些代码的格式统一：大写的代码后跟小写的“j”或“n”，具体取决于它是在白天还是黑夜的列中键入的。 （代码是预定义的，但我不想使用不同代码的下拉列表）

示例：如果用户在日列中键入“r”，则单元格值应更改为“Rj”。

如果用户输入“rj”、“rn”、“RJ”……它仍然应该返回“Rj”。

因此，如果用户已经有一个“Rj”单元格并将值向右拖动，它应该交替使用“Rj”和“Rn”

例外：如果用户输入“x”，它应该只返回一个大写的“X”

问题：

我为每个循环遍历目标单元格（如果用户将数据拖动到相邻的列或行，可以是一个或多个单元格）创建一个循环。 但是，即使只有一个单元格，也似乎循环发生了多次，并且确实减慢了更改单元格数据的过程。

我尝试同时使用 if 语句和 select case 来查看它是否对效率产生了影响 - select case 稍微快一点（即使它的时间要长得多），但仍然需要很长时间。

我想知道这是否是我的电脑，但它是一台最新且功能强大的机器 - 所有其他编程都运行得很好。

另外，即使满足 a case 条件，Case Else 似乎还是被执行了...

我发现通过在 case 字符串中添加空格有助于加快进程，因为如果一个单元格多次通过 for each ，因为它被分配了一个没有空格的值，它不会对应于不同的情况。

您会在我的代码末尾注意到有些代码无法在周末或夜间使用（由于 Case Else 问题，在 select 案例中进行了注释）。如果这些需要更长的时间来执行对我来说并不重要，但我不希望它减慢其他选项的速度。

日程安排如下：

night/day schedule

这是我的 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) = "N" Then
                cell.Value = ""
            Else:
                cell.Value = UCase(cell.Value)
            End If

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

这是我在第二个示例中用于代码的单元格

cells with codes

感谢任何帮助。我希望这不是太多信息，我不想错过任何东西！

解决方法

当您从事件处理程序更新工作表时，这将再次触发该事件，这可能导致无限循环或至少会导致执行速度问题。如果您要更新受监控区域中的工作表，请使用 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