Два цикла в одном коде

Question

Я мог бы использовать некоторую помощь, исправляя приведенный ниже код, поскольку то, что показано при активации, является первым изображением, в то время как я хочу сделать второе изображение.

Также, если у вас есть другой код для выполнения той же работы, пожалуйста. заблаговременно за вашу помощь.

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

Используйте {и} в разделе стайлинг/заголовки, выше, где вы печатаете, чтобы вставить отформатированный код в следующий раз, пожалуйста, так, что это выглядит следующим образом. :)

Отредактировано с ответом:

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

Вы получаете результат, потому что вы делаете это для каждой ячейки в аз, но вы не wan't сделать это так, вы должны заполнить только столбец от найденного Пт или Сб.

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

^{Кроме того, если у вас есть другой код, чтобы сделать ту же работу, пожалуйста.}

Ниже будет предложено создать новый рабочий лист календаря на основе текущего месяца каждый раз, когда вы создадите новый рабочий лист.

ThisWorkbook code sheet:

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 

Вы, вероятно, хотите, чтобы внести изменения, но это может быть хорошей основой для начала работы. Я использовал подход к использованию фактических дат и обращая внимание на их день недели и день недели через ячейку Number Format Code. Это оставляет исходные значения даты, доступные для расчета и поиска. Аналогично, даты, которые отображаются пустыми, на самом деле не пусты; формат пользовательского номера, который был применен через Conditional Formatting, просто не показывает никакого значения в ячейке.

Answer 4

Я нашел ответ на часть вопроса, но мне нужна помощь, чтобы закончить код, как это относится только к одной строке.

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