Question

我从stackoverflow.com获得了此代码，我可以根据输入框上提供的月份和年份生成每周报告，

我对此代码进行了一些修改，但现在我想在此代码中进行更多更改以完成其他一些要求。

我希望每年将每年显示在顶部列中，
在每个月之间获取一条粗线来分隔它们。

我尝试修改代码，但无法为此找到解决方案。

Sub SetWeeklySplitForRevenue()

    Dim intDay As Integer, firstIter As Integer
    Dim startMonth As Date, endMonth As Date
    Dim str As String
    Dim IsStartMonth As Boolean, IsEndMonth As Boolean
    Dim rng As Range, Rng1 As Range, Rng2 As Range
    Dim I As Long
    Dim ws As Worksheet

Sheets("WeekWise_Revenue").Activate

    Application.ScreenUpdating = False
    firstIter = 1
    Set ws = ThisWorkbook.Sheets("WeekWise_Revenue") 'change Sheet4 to your sheet
    IsStartMonth = False
    IsEndMonth = False
    Do
        If Not IsStartMonth Then

            'get start date
            str = InputBox("Enter Start Date in month-year format " & vbCrLf & "(Example: Sep 2017 or September 2017)", "Start Date", "Jan 2018")
            If IsDate(str) Then                  'if entery is valid date
                startMonth = str
                IsStartMonth = True
            ElseIf IsEmpty(str) Then             'if nothing is entered
                IsStartMonth = True
            ElseIf StrPtr(str) = 0 Then          'user clicks close
                IsStartMonth = True

   'If user hit cancel, it will call the sub to cleare the page
   If str = "" Then
   CreateObject("WScript.Shell").PopUp "User clicked Cancle button", 1, "Operation aborted", vbExclamation
   Call Reset_Page_ForRevenue
   Exit Sub
   Else
   Exit Do
   End If

                Exit Sub
            Else                                 'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        Else

            'get end date
            str = InputBox("Enter End Date in month-year format " & vbCrLf & "(Example: Sep 2017 or September 2017)", "End Date", "Jan 2018")
            If IsDate(str) Then                  'if entery is valid date
                endMonth = DateAdd("d", -1, DateAdd("m", 1, str))
                IsEndMonth = True
            ElseIf IsEmpty(str) Then             'if nothing is entered
                IsEndMonth = True
            ElseIf StrPtr(str) = 0 Then          'user clicks close
                IsEndMonth = True

   'If user hit cancel, it will call the sub to cleare the page
   If str = "" Then
   CreateObject("WScript.Shell").PopUp "User clicked Cancle button", 1, "Operation aborted", vbExclamation
   Call Reset_Page_ForRevenue
   Exit Sub
   Else
   Exit Do
   End If
                 Exit Sub
            Else                                 'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        End If
    Loop Until IsStartMonth And IsEndMonth

    Set rng = ws.Range("D2")
    Set Rng1 = rng.Offset(-1, I)
    intDay = 0

    Do
        If Format(startMonth + intDay, "ddd") = "Mon" Then 'check whether date is Monday
            rng.Offset(-1, I).Value = MonthName(Format(startMonth + intDay, "m"))
            rng.Offset(0, I).Value = Format(startMonth + intDay, "mmm" & "d") 'display monday dates (remove {"mmm" &} from this to get the date only under this field)
            I = I + 1
            intDay = intDay + 7

            'merge cells in Row 1
            If Rng1.Value = rng.Offset(-1, I - 1).Value Then
                If firstIter <> 1 Then
                    rng.Offset(-1, I - 1).Value = ""
                End If
                firstIter = 0
                With Range(Rng1, rng.Offset(-1, I - 1))
                    .Merge
                    .HorizontalAlignment = xlCenter

    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
    End With


                End With
                ''Call SetborderforMonth
            Else
                Set Rng1 = rng.Offset(-1, I - 1)
            End If

        Else
            intDay = intDay + 1
        End If
    Loop Until CDate(startMonth + intDay) > CDate(endMonth) 'loop till start date is less then end date
    Application.ScreenUpdating = True

Call Set_border_ForRevenue

End Sub

预期的屏幕可能如下所示

如果有任何解决方案，请帮助我。

谢谢

Answer 1

要将年份添加到标题中，请交换您的代码行：

 rng.Offset(-1, I).Value = MonthName(Format(startMonth + intDay, "m"))

有了这个：

x = MonthName(Format(startMonth + intDay, "m"))
rng.Offset(-1, I).Value = x & "'" & Format(startMonth + intDay, "yy")

<强>更新

Sub SetWeeklySplitForRevenue()
    Dim intDay As Integer, firstIter As Integer
    Dim startMonth As Date, endMonth As Date
    Dim str As String
    Dim IsStartMonth As Boolean, IsEndMonth As Boolean
    Dim rng As Range, Rng1 As Range, Rng2 As Range
    Dim I As Long
    Dim ws As Worksheet

    Sheets("WeekWise_Revenue").Activate

    Application.ScreenUpdating = False
    firstIter = 1
    Set ws = ThisWorkbook.Sheets("WeekWise_Revenue") 'change Sheet4 to your sheet

    IsStartMonth = False
    IsEndMonth = False
    Do
        If Not IsStartMonth Then

            'get start date
            str = InputBox("Enter Start Date in month-year format " & vbCrLf & "(Example: Sep 2017 or September 2017)", "Start Date", "Jan 2018")

            If IsDate(str) Then                  'if entery is valid date
                startMonth = str
                IsStartMonth = True
            ElseIf IsEmpty(str) Then             'if nothing is entered
                IsStartMonth = True
            ElseIf StrPtr(str) = 0 Then          'user clicks close
                IsStartMonth = True
                Exit Sub
                               'If user hit cancel, it will call the sub to cleare the page
                If str = "" Then
                    MsgBox "User clicked Cancel button", 1, "Operation aborted", vbExclamation
                    Call Reset_Page_ForRevenue
                    Exit Sub
                Else
                    Exit Do
                End If

            Else                                 'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        Else

            'get end date
            str = InputBox("Enter End Date in month-year format " & vbCrLf & "(Example: Sep 2017 or September 2017)", "End Date", "Jan 2018")

            If IsDate(str) Then                  'if entery is valid date
                endMonth = DateAdd("d", -1, DateAdd("m", 1, str))
                IsEndMonth = True
            ElseIf IsEmpty(str) Then             'if nothing is entered
                IsEndMonth = True
            ElseIf StrPtr(str) = 0 Then          'user clicks close
                IsEndMonth = True
                Exit Sub
                                   'If user hit cancel, it will call the sub to cleare the page
                If str = "" Then
                    MsgBox "User clicked Cancel button", 1, "Operation aborted", vbExclamation
                    Call Reset_Page_ForRevenue
                    Exit Sub
                Else
                    Exit Do
                End If
            Else                                 'display input box again
                Call MsgBox("Enter a valid date", vbCritical + vbOKOnly, "Date Only")
            End If
        End If
    Loop Until IsStartMonth And IsEndMonth
    I = 0
    Set rng = ws.Range("D2")
    Set Rng1 = rng.Offset(-1, I)
    intDay = 0

    Do
        If Format(startMonth + intDay, "ddd") = "Mon" Then 'check whether date is Monday
            x = MonthName(Format(startMonth + intDay, "m"))
            rng.Offset(-1, I).Value = x & "'" & Format(startMonth + intDay, "yy")
            rng.Offset(0, I).Value = Format(startMonth + intDay, "mmm" & "d") 'display monday dates (remove {"mmm" &} from this to get the date only under this field)
            I = I + 1
            intDay = intDay + 7

            'merge cells in Row 1
            If Rng1.Value = rng.Offset(-1, I - 1).Value Then
                If firstIter <> 1 Then
                    rng.Offset(-1, I - 1).Value = ""
                End If
                firstIter = 0
                With Range(Rng1, rng.Offset(-1, I - 1))
                    .Merge
                    .HorizontalAlignment = xlCenter

                    With .Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                    End With
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                    End With
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                    End With
                    With .Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                    End With

                End With
                Call SetborderforMonth
            Else
                Set Rng1 = rng.Offset(-1, I - 1)
                newcol = rng.Offset(-1, I - 1).Column
                With Columns(newcol)
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    With .Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThick
                    End With
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThick
                    End With
                    .Borders(xlEdgeRight).LineStyle = xlNone
                    .Borders(xlInsideVertical).LineStyle = xlNone

                End With
            End If

        Else
            intDay = intDay + 1
        End If
    Loop Until CDate(startMonth + intDay) > CDate(endMonth) 'loop till start date is less then end date
    Application.ScreenUpdating = True

Call Set_border_ForRevenue

End Sub

代码审查/修改：使用宏分周

1 个答案: