一个代码中的两个循环

时间:2016-03-11 12:23:22

标签: excel vba excel-vba calendar

我可以使用一些帮助来纠正下面的代码,因为当我想要拍摄第二张图像时,激活时显示的是第一张图像。

此外,如果您有其他代码来执行相同的工作,请执行此操作。在此先感谢您的帮助。

enter image description here

 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

4 个答案:

答案 0 :(得分:2)

使用上面键入的样式/标题部分中的{和},下次请插入格式化代码,使其看起来像这样。 :)

编辑你的回答:

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

答案 1 :(得分:1)

你得到的结果是因为你为az中的每个单元格做了这个,但是你不想这样做,你必须只填充找到的Fri或Sat的列。

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

应该是我想的那样

答案 2 :(得分:0)

  

如果你有其他代码要做同样的工作,请做。

以下内容将要求您在每次创建新工作表时根据当前月份构建新的日历工作表。

thisworkbook
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应用的自定义数字格式在单元格中根本不显示任何值。

auto_calendar

答案 3 :(得分:0)

我找到了部分问题的答案,但我需要帮助才能完成代码,因为它仅适用于一行。

enter image description here

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