两个循环在一个代码中

我可以使用一些帮助纠正下面的代码，当激活时显示的是第一个图像，而我想要做第二个图像。

另外，如果你有其他的代码来做同样的工作，请做。 提前感谢你的帮助。

Private Sub Worksheet_Activate() Dim rng As Range, cell As Range Dim a As Range, az As Range Application.EnableEvents = False Set rng = Range("A2:AE2") Set az = Range("A3:AE6") For Each cell In rng For Each a In az If cell.Value = "Fri" Then a.Value = "Fri" ElseIf cell.Value = "Sat" Then a.Value = "Sat" End If Next a Next cell Application.EnableEvents = True End Sub 

Answer 1

在你input的上面的样式/标题部分使用{和}，下次插入格式化的代码，使其看起来像这样。 🙂

用你的答案编辑：

 Private Sub Worksheet_Activate() Dim rng As Range, cell As Range Dim a As Range, az As Long 'set az = number of rows you want filled with fri/sat Application.EnableEvents = False Set rng = Range("A2:AE2") az = 4 For Each cell In rng If cell.Value = "fri" Then For i = 1 To az cell.Offset(i).Value = "fri" Next i ElseIf cell.Value = "sat" Then For i = 1 To az cell.Offset(i).Value = "sat" Next i End If Next cell Application.EnableEvents = True End Sub 

Answer 2

你得到的结果是因为你为每个单元格在az中执行，但是你不想这么做，所以你只需填写find的周五或周六的列。

 Private Sub Worksheet_Activate() Dim rng As Range, cell As Range Application.EnableEvents = False Set rng = Range("B2:BE2") For Each cell In rng If cell.value = "Fri" Then For i as Integer = 3 To 6 Step 1 Cells(i,cell.column).Value = "Fri" Next End If If cells.value = "Sat" Then For i as Integer = 3 To 6 Step 1 Cells(i,cell.column).Value = "Sat" Next End If Next cell Application.EnableEvents = True End Sub 

应该是这样的，我想

Answer 3

^{另外，如果你有其他的代码来做同样的工作，请做。}

每当您创build一个新的工作表时，以下将要求基于当前月份build立一个新的日历工作表。

ThisWorkbook代码表：

 Option Explicit Private Sub Workbook_NewSheet(ByVal Sh As Object) If MsgBox("Create new calendar?", vbYesNo, "AutoBuild") <> vbYes Then Exit Sub 'the following DELETES ANY WORKSHEET WITH THE SAME MONTH/YEAR NAME On Error Resume Next Application.DisplayAlerts = False Worksheets(Format(Date, "mmm yyyy")).Delete Application.DisplayAlerts = True On Error GoTo 0 'create a new calendar worksheet based on the current month With Sh Dim c As Long .Name = Format(Date, "mmm yyyy") With .Cells(1, 1).Resize(6, Day(DateSerial(Year(Date), Month(Date) + 1, 0))) .Formula = "=DATE(" & Year(Date) & ", " & Month(Date) & ", COLUMN())" .Value = .Value .Rows(1).NumberFormat = "d" .Rows(2).Resize(.Rows.Count - 1, .Columns.Count).NumberFormat = "ddd" .EntireColumn.ColumnWidth = 5 'AutoFit .HorizontalAlignment = xlCenter With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0) With .FormatConditions .Delete .Add Type:=xlExpression, Formula1:="=AND(ROW()>2, WEEKDAY(A2, 15)>2)" .Add Type:=xlExpression, Formula1:="=WEEKDAY(A2, 15)<3" .Add Type:=xlExpression, Formula1:="=AND(ROW()=2, WEEKDAY(A2, 15)>2)" End With .FormatConditions(1).NumberFormat = ";;;" .FormatConditions(2).Interior.Color = 5287936 .FormatConditions(3).Interior.Color = 14281213 End With End With With ActiveWindow .SplitColumn = 0 .SplitRow = 1 .FreezePanes = True .Zoom = 80 End With End With End Sub 

你可能会想调整，但这可能是一个很好的框架开始。 我已经采取了使用实际date的方法，并通过单元格数字格式代码来将其date和星期几延迟。 这留下了原始基础date值（s）可用于计算和查找。 同样，显示空白的date实际上不是空白的; 通过条件格式化应用的自定义数字格式在单元格中根本不显示任何值。

Answer 4

我已经find了部分问题的答案，但是我需要帮助完成代码，因为它只适用于一行。

 Private Sub Worksheet_Activate() Dim cell As Range, rng As Range Application.EnableEvents = False Set rng = Range("A2:AE2") For Each cell In rng If Cells(2, cell.Column) = "Fri" Then Cells(3, cell.Column) = "Fri" ElseIf Cells(2, cell.Column) = "Sat" Then Cells(3, cell.Column) = "Sat" End If Next cell Application.EnableEvents = True End Sub