![](/img/trans.png)
[英]Excel VBA For Each Worksheet Loop (Run Same VBA Macro Code On Multiple Sheets)
[英]How can I run multiple VBA code on the same worksheet
我目前正在运行以下代码:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Worksheet_SelectionChange Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If Intersect(.Cells, Range("E4:K120")) Is Nothing Or .Count > 1 Then Exit Sub
Select Case .Value
Case ""
.Interior.ColorIndex = 3
Case 1
.Interior.ColorIndex = xlNone
.Value = vbNullString
Exit Sub
Case Else
Exit Sub
End Select
.Value = .Value + 1
End With
End Sub
我现在需要在同一个工作表上为不同的单元格范围运行类似的代码。 单击 N 列中的单元格时,我需要代码循环显示 4 种不同的颜色和文本。 我不是编码员,所以这远高于我的薪水。 谢谢!
也许是这样的:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Set a flag to let us know if we're in that "one color" range or "four color" range
Dim GroupIndicator As Integer
GroupIndicator = 0
With Target
'if our selection has more than one cell, just don't do anything (exit the sub)
If .Count > 1 Then
Exit Sub
End If
'if our selection is in the first range, set our indicator to 1. if it's in the second range, set the indicator to 2
If Not Intersect(.Cells, Range("E4:K120")) Is Nothing Then
GroupIndicator = 1
ElseIf Not Intersect(.Cells, Range("N4:N120")) Is Nothing Then
GroupIndicator = 2
Else
Exit Sub
End If
'do this block if indicator is 1 (the first range). If there's no value, make the cell red and put in a value of 1. Otherwise, clear the color and remove the value
If GroupIndicator = 1 Then
If .Value = "" Then
.Interior.ColorIndex = 3
.Value = 1
Else
.Interior.ColorIndex = xlNone
.Value = vbNullString
End If
End If
'do this block if indicator is 2 (the second range). increment our value and then assign the value indicated.
If GroupIndicator = 2 Then
.Value = .Value + 1
Select Case .Value
Case 1
.Interior.ColorIndex = 5
Case 2
.Interior.ColorIndex = 6
Case 3
.Interior.ColorIndex = 7
Case 4
.Interior.ColorIndex = 8
Case Else
.Interior.ColorIndex = xlNone
.Value = vbNullString
End Select
End If
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.