VBA EXCEL MACRO-在target.cell中循环时更改单元格值

Question

上下文：

我一直在Excel上创建一个时间表，我想在用户添加信息时让一些事情变得更简单。

每天分为白天和夜晚(法语中的"jour"one_answers"nuit"：所以我用"J"one_answers"N"作为标识符(

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

示例：如果用户键入"；r〃；在day列中，单元格值应更改为"0"；Rj"；。

如果用户键入"；rj"rn"RJ"。。。它应该仍然返回"；Rj"；。

因此，如果用户已经有一个"；Rj"；单元格，并将该值向右拖动；Rj"；以及"；Rn"；

例外：如果用户键入"；x〃；它应该只返回一个大写的"；X〃；

问题：

我为每个循环创建一个循环，循环通过目标单元格(如果用户将数据拖动到相邻的列或行，则可以是一个或多个单元格(。然而，即使只有一个单元格，循环似乎发生了多次，这确实减缓了更改单元格数据的过程。

我试过同时使用if语句和select case，看看它是否在效率上有所不同——select case稍微快一点(尽管它要长得多(，但它仍然需要很长时间。

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

此外，即使满足了一个case条件，case Else似乎仍在执行。。。

我发现，在大小写字符串中添加空格有助于加快处理速度，因为如果一个单元格多次通过for，因为它被分配了一个不带空格的值，所以它不会对应于不同的大小写。

您会在我的代码末尾注意到，有些代码不能在周末或晚上使用(由于case Else问题，在select case中进行了注释(。如果这些需要更长的时间来执行，对我来说并不重要，但我不希望它减缓其他选项的速度。

时间表如下：

夜间/日间时间表

这是我的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