代码审查/修改：使用宏分周
我从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
预期的屏幕可能如下所示
如果有任何解决方案，请帮助我。
谢谢
1 个答案:
答案 0 :(得分：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
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？