问题描述
背景:
我一直致力于在 Excel 上创建日程表,我想让用户在添加信息时做一些更简单的事情。
每天分为白天和黑夜(法语中的“jour”和“nuit”:所以我使用“J”和“N”作为标识符)
我目前正在创建一个宏,当一个或多个单元格在某个范围内(即计划中的一个单元格)发生更改时,该宏会执行。如果在单元格中键入并提交某些字符串代码,我希望这些代码的格式统一:大写的代码后跟小写的“j”或“n”,具体取决于它是在白天还是黑夜的列中键入的。 (代码是预定义的,但我不想使用不同代码的下拉列表)
示例:如果用户在日列中键入“r”,则单元格值应更改为“Rj”。
如果用户输入“rj”、“rn”、“RJ”……它仍然应该返回“Rj”。
因此,如果用户已经有一个“Rj”单元格并将值向右拖动,它应该交替使用“Rj”和“Rn”
问题:
我为每个循环遍历目标单元格(如果用户将数据拖动到相邻的列或行,可以是一个或多个单元格)创建一个循环。 但是,即使只有一个单元格,也似乎循环发生了多次,并且确实减慢了更改单元格数据的过程。
我尝试同时使用 if 语句和 select case 来查看它是否对效率产生了影响 - select case 稍微快一点(即使它的时间要长得多),但仍然需要很长时间。
我想知道这是否是我的电脑,但它是一台最新且功能强大的机器 - 所有其他编程都运行得很好。
另外,即使满足 a case 条件,Case Else 似乎还是被执行了...
我发现通过在 case 字符串中添加空格有助于加快进程,因为如果一个单元格多次通过 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) = "N" Then
cell.Value = ""
Else:
cell.Value = UCase(cell.Value)
End If
End If
Next cell
End If
done:
Exit Sub
End Sub
这是我在第二个示例中用于代码的单元格
感谢任何帮助。我希望这不是太多信息,我不想错过任何东西!
解决方法
当您从事件处理程序更新工作表时,这将再次触发该事件,这可能导致无限循环或至少会导致执行速度问题。如果您要更新受监控区域中的工作表,请使用 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