如何 运行 3 个循环用于多个工作表的条件格式设置
How to run 3 loops for conditional formatting over multiple worksheets
我试图在不使用 Select
的情况下有条件地设置 4 个不同范围的工作表的格式
我正在尝试清理我非常疯狂的初学者代码并加快进程,但循环不起作用。工作表 2 和 3 范围内的所有空单元格都应填充 "T"。工作表 4 和 5 范围内的空单元格应为 "p"。
工作表 2-4 中包含数据的所有单元格的格式相同:粗体、居中对齐、框架、根据单元格文本有条件地替换文本以及字体和字体颜色。
Sub comfor()
Dim ws As Worksheet, cell As Range
For Each ws In ActiveWorkbook.Sheets
For i = 2 To 3
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
If Text = "" Then
Value = "T"
End If
Next
End With
Next
For i = 4 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
If Text = "Not Recorded" Then
Value = "p"
End If
Next
End With
Next
For i = 2 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
With cell
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With cell
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With cell
If .Text = "Incomplete" Then
.Font.Color = vbRed
.Value = "T"
.Font.Name = "Wingdings 2"
ElseIf .Text = "Not Applicable" Then
.Name = "Webdings"
.Value = "x"
.Font.Color = RGB(255, 192, 0)
ElseIf .Text = "Complete" Then
.Font.Color = 5287936
.Value = "R"
.Font.Name = "Wingdings 2"
ElseIf .Text = "Not Recorded" Then
.Font.Color = RGB(129, 222, 225)
.Value = "p"
.Font.Name = "Wingdings"
End If
End With
Next
End With
Next
Next
End Sub
用这个替换你的循环 - 循环与 With
语句的作用不同 - 你仍然必须明确引用 cell.Text/cell.Value
- 除非你想嵌入 With
声明 inside 你的循环 - 你绝对可以 - 但即使那样,也需要 .Text
和 .Value
.
For i = 2 To 3
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "T"
End If
Next
End With
Next
For i = 4 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "Not Recorded" Then
cell.Value = "p"
End If
Next
End With
Next
我发现如果我使用 Select Case 和 ws Name 而不是 i 并在每个 Select Case 之前添加“For Each ws..”,它会运行得非常快。也许不是最优雅,但最有效。
Sub comfor()
Dim daily As Worksheet, mon As Worksheet, per As Worksheet, surf As Worksheet
Dim ws As Worksheet, cell As Range
Set daily = Sheets("Daily")
Set per = Sheets("Personnel")
Set surf = Sheets("Testing")
Set mon = Sheets("Monthly")
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Daily", "Monthly"
For Each cell In ws.Range(("A6"),_
ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "T"
cell.Font.Color = vbRed
cell.Value = "T"
cell.Font.Name = "Wingdings 2"
End If
Next
End Select
Next
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Personnel", "Testing"
For Each cell In ws.Range(("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "p"
cell.Font.Color = RGB(255, 192, 0)
cell.Value = "p"
cell.Font.Name = "Wingdings 3"
End If
Next
End Select
Next
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Daily", "Monthly", "Personnel", "Testing"
For Each cell In ws.Range(ws.Range("A6"),_
ws.Range("A6").SpecialCells(xlLastCell)).Cells
With cell
.HorizontalAlignment = xlCenter
End With
With cell
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
If cell.Text = "Incomplete" Then
cell.Font.Color = vbRed
cell.Value = "T"
cell.Font.Name = "Wingdings 2"
ElseIf cell.Text = "Not Applicable" Then
cell.Name = "Webdings"
cell.Value = "x"
cell.Font.Color = RGB(255, 192, 0)
ElseIf cell.Text = "Complete" Then
cell.Font.Color = 5287936
cell.Value = "R"
cell.Font.Name = "Wingdings 2"
End If
Next
End Select
Next
End Sub
我试图在不使用 Select
的情况下有条件地设置 4 个不同范围的工作表的格式我正在尝试清理我非常疯狂的初学者代码并加快进程,但循环不起作用。工作表 2 和 3 范围内的所有空单元格都应填充 "T"。工作表 4 和 5 范围内的空单元格应为 "p"。 工作表 2-4 中包含数据的所有单元格的格式相同:粗体、居中对齐、框架、根据单元格文本有条件地替换文本以及字体和字体颜色。
Sub comfor()
Dim ws As Worksheet, cell As Range
For Each ws In ActiveWorkbook.Sheets
For i = 2 To 3
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
If Text = "" Then
Value = "T"
End If
Next
End With
Next
For i = 4 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
If Text = "Not Recorded" Then
Value = "p"
End If
Next
End With
Next
For i = 2 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
With cell
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With cell
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
With cell
If .Text = "Incomplete" Then
.Font.Color = vbRed
.Value = "T"
.Font.Name = "Wingdings 2"
ElseIf .Text = "Not Applicable" Then
.Name = "Webdings"
.Value = "x"
.Font.Color = RGB(255, 192, 0)
ElseIf .Text = "Complete" Then
.Font.Color = 5287936
.Value = "R"
.Font.Name = "Wingdings 2"
ElseIf .Text = "Not Recorded" Then
.Font.Color = RGB(129, 222, 225)
.Value = "p"
.Font.Name = "Wingdings"
End If
End With
Next
End With
Next
Next
End Sub
用这个替换你的循环 - 循环与 With
语句的作用不同 - 你仍然必须明确引用 cell.Text/cell.Value
- 除非你想嵌入 With
声明 inside 你的循环 - 你绝对可以 - 但即使那样,也需要 .Text
和 .Value
.
For i = 2 To 3
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "T"
End If
Next
End With
Next
For i = 4 To 5
With Sheets(i)
For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "Not Recorded" Then
cell.Value = "p"
End If
Next
End With
Next
我发现如果我使用 Select Case 和 ws Name 而不是 i 并在每个 Select Case 之前添加“For Each ws..”,它会运行得非常快。也许不是最优雅,但最有效。
Sub comfor()
Dim daily As Worksheet, mon As Worksheet, per As Worksheet, surf As Worksheet
Dim ws As Worksheet, cell As Range
Set daily = Sheets("Daily")
Set per = Sheets("Personnel")
Set surf = Sheets("Testing")
Set mon = Sheets("Monthly")
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Daily", "Monthly"
For Each cell In ws.Range(("A6"),_
ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "T"
cell.Font.Color = vbRed
cell.Value = "T"
cell.Font.Name = "Wingdings 2"
End If
Next
End Select
Next
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Personnel", "Testing"
For Each cell In ws.Range(("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
If cell.Text = "" Then
cell.Value = "p"
cell.Font.Color = RGB(255, 192, 0)
cell.Value = "p"
cell.Font.Name = "Wingdings 3"
End If
Next
End Select
Next
For Each ws In ActiveWorkbook.Sheets
Select Case ws.Name
Case "Daily", "Monthly", "Personnel", "Testing"
For Each cell In ws.Range(ws.Range("A6"),_
ws.Range("A6").SpecialCells(xlLastCell)).Cells
With cell
.HorizontalAlignment = xlCenter
End With
With cell
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With
If cell.Text = "Incomplete" Then
cell.Font.Color = vbRed
cell.Value = "T"
cell.Font.Name = "Wingdings 2"
ElseIf cell.Text = "Not Applicable" Then
cell.Name = "Webdings"
cell.Value = "x"
cell.Font.Color = RGB(255, 192, 0)
ElseIf cell.Text = "Complete" Then
cell.Font.Color = 5287936
cell.Value = "R"
cell.Font.Name = "Wingdings 2"
End If
Next
End Select
Next
End Sub