Question

我正在使用Excel 2010，并且要求显示2行标题，其中第1行显示年份，第2行显示月份。这是在24个月的时间内，将由数据中其他地方的另一个日期驱动。 24个月期限将从驱动这些动态标头的日期开始。为便于展示，月份仅显示第一个字母，年份将合并并在每个相关年度中心。

例如，今天的日期将生成： -

Sample image

作为测试，假设在A1中输入了一个日期，我创建了这个有效的短代码，但生成所需的标题需要10秒，我不明白为什么。

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
    Dim rngDate As Range
    Dim c As Range
    Dim i As Byte
    Dim rngYearStart As Range
    Dim rngYearEnd As Range
    Dim bytNumMonths As Byte
    Dim d As Date

    'Set inital ranges and columns
    Set rngDate = Range("A1")
    Set c = Range("C2")
    Set rngYearStart = c.Offset(-1, 0)
    bytNumMonths = 24

    If Not Intersect(Target, rngDate) Is Nothing Then
        With Application
            'Turn off screen refresh and alerts
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False

            'Unmerge current year headings
            'Force width if month heading columns.  Must be able to show yyyy
            Range(rngYearStart.Address & ":" & c.Offset(-1, bytNumMonths - 1).Address).UnMerge
            Range(rngYearStart.Address & ":" & c.Offset(-1, bytNumMonths - 1).Address).ColumnWidth = 4

            'Loop through number of columns and set values
            For i = 0 To bytNumMonths - 1
                d = DateAdd("m", i, rngDate)

                If Month(d) = 12 Then
                    Set rngYearEnd = c.Offset(-1, i)

                    rngYearStart.Value = Year(d)
                    Range(rngYearStart.Address & ":" & rngYearEnd.Address).Merge
                    Range(rngYearStart.Address & ":" & rngYearEnd.Address).HorizontalAlignment = xlCenter
                End If
                If Month(d) = 1 Then
                    Set rngYearStart = c.Offset(-1, i)
                End If
                c.Offset(0, i).Value = d
                c.Offset(0, i).HorizontalAlignment = xlCenter
                c.Offset(0, i).NumberFormat = "mmmmm"
            Next

            'Set values for last column after loop
            Set rngYearEnd = c.Offset(-1, bytNumMonths - 1)

            rngYearStart = Year(d)
            Range(rngYearStart.Address & ":" & rngYearEnd.Address).Merge
            Range(rngYearStart.Address & ":" & rngYearEnd.Address).HorizontalAlignment = xlCenter
        End With
    End If

ExitHandler:
    'Turn on screen refresh and alerts
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

Exit Sub

ErrorHandler:
    MsgBox "There was an error." & vbNewLine & vbNewLine & _
           "ERROR: " & Err.Number & " - " & Err.Description

    Resume ExitHandler

End Sub

正如您所看到的那样，非常简单，循环几个月并为相关单元格指定值。

有人可以看看这段代码，如果我正确地和/或最有效的方式，请告诉我。正如我所说，它确实有效，但速度很慢，我没有得到。请注意，我已确保此代码在新工作簿中运行，其他任何内容都可能会降低其速度。这是他最好的方式吗？

为网格构建动态年/月标头

0 个答案: