时间戳

首页 > 解决方案 > 通过 VBA 在 Excel 中创建可视日历

excel - 通过 VBA 在 Excel 中创建可视日历

问题描述

我的程序做了我期望做的事情。我对最后一个循环不满意。

Option Explicit
Public Sub calendar()
Dim i, j

Dim mDay As Date
For i = 1 To 12
    Cells(1, i + 1).Value = MonthName(i)
    For j = 2 To 32
        If IsDate(j - 1 & "/" & i & "/" & Year(Date)) Then
           mDay = CDate(j - 1 & "/" & i & "/" & Year(Date))
            Cells(j, i + 1).Value = mDay
            If Weekday(mDay) = 1 Then
                Cells(j, i + 1).Interior.Color = vbRed
                ElseIf Weekday(mDay) = 7 Then
                Cells(j, i + 1).Interior.Color = vbYellow
                Else
                Cells(j, i + 1).ClearFormats
            End If
                      Cells(j, i + 1).Value = Format(mDay, "DDDD")
                    
        End If
    Next j
Next I
For i = 1 To 31
    Cells(i + 1, 1).Value = i
Next i
End Sub

我已经有一个计数为 31 的循环，但如果我把它放在那里，它将被执行 12 次。有更聪明的方法吗？

标签： excelvba

解决方案

我会将值分配到一个数组中，然后写入工作表 1 次，这样应该会更快。（读/写到/从单元格是昂贵的操作）

Sunday然后对and使用条件格式Saturday：

Public Sub calendar()
    Dim i As Long, j As Long

    Dim outputArr() As Variant
    ReDim outputArr(1 To 32, 1 To 13) As Variant

    For i = 1 To 12
        outputArr(1, i + 1) = MonthName(i)
        For j = 2 To 32
            If IsDate(j - 1 & "/" & i & "/" & Year(Date)) Then
                outputArr(j, i + 1) = Format(DateSerial(Year(Date), i, j - 1), "DDDD")
            End If
        Next j
    Next i
    
    For i = 1 To 31
        outputArr(i + 1, 1) = i
    Next i
    
    Dim calendarRng As Range
    Set calendarRng = Range("A1").Resize(32, 13)
    
    Dim formatSunday As FormatCondition
    Set formatSunday = calendarRng.FormatConditions.Add(xlCellValue, xlEqual, Formula1:="=" & Chr(34) & Format(Date - Weekday(Date, vbSunday) + 1, "DDDD") & Chr(34))
    formatSunday.Interior.Color = vbRed
    
    Dim formatSaturday As FormatCondition
    Set formatSaturday = calendarRng.FormatConditions.Add(xlCellValue, xlEqual, Formula1:="=" & Chr(34) & Format(Date - Weekday(Date, vbSaturday) + 1, "DDDD") & Chr(34))
    formatSaturday.Interior.Color = vbYellow
    
    calendarRng.Value = outputArr
End Sub

推荐阅读