如果用户提供特定的月份，请使用macros分割星期

我是新来的macros，但有一些基本的想法是如何工作或能够写小VBA代码。

我正在试着做一个周报。 那么，如果我给出一个特定的月份或几个月（将起诉一个提示提供开始date和结束date的input框），那么是否有可能在Excel表格中获得几周（每周的开始date将是星期一）。

喜欢如果我给2017年10月到2017年12月，我会得到一个像我附图像图像

过去1个月，我试图自己find一个解决scheme，但是我无法在这方面取得成功。 如果有人可以帮助我的代码，这将是非常感激的。 🙂

Answer 1

以下应该有所帮助

Sub Demo() 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 Application.ScreenUpdating = False firstIter = 1 Set ws = ThisWorkbook.Sheets("Sheet4") '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 & "(like Sep 2017 or September 2017)", "Date") 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 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 & "(like Sep 2017 or September 2017)", "Date") 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 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("B2") ws.Range("A2") = "Dates" Set rng1 = rng.Offset(-1, i) intDay = intDay + 1 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, "d") 'display monday dates 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 End With 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 End Sub 

看图像以供参考。

input框

产量