Excel VBA – 在日历中input开始date和结束date

我目前正试图想出一个关于如何编写VBA脚本的想法，该脚本将扫描项目的开始date的某些列，并将date放在日历中的相应单元格中。 为了使事情更清晰，下面是一个基本的看法：

正如你所看到的日历包含月份以及每个新周开始（星期一）的日子。 例如：第4行中的项目从2017年4月10日开始。脚本应扫描该单元格，并用10填充D4。第5行中的项目从5月3日开始，因此它应填入值为3的G5。对于所有其他行和结束date以及。

到目前为止，我有一个想法，让macros观扫描每个单元格，并在2017年（即每年的每一天）将其与每个可能的条目进行比较。 这看起来有点像这样：

destiny_row = 1 For x = 2 To MaxRowList If InStr(1, ActiveSheet.Cells(x, 1), "10.04.2017") > 0 Then ActiveSheet.Range("$D$" & x).Value = "10" destiny_row = destiny_row + 1 End If Next 

但是，正如你可以想象的那样，这将是相当一段代码，人们必须写，因为你必须写在一年中的每一天，然后复制它的结束date，它不会是非常有效的。

有没有人有一个明智的方式如何做到这一点？ 任何帮助表示赞赏。 提前致谢。

---

编辑1：所以，我试图尽我所能地执行评论中提到的内容。 这是我到目前为止：

 Sub Example4() Dim objDate1 As Date Dim objDate2 As Date Dim objDate3 As Date Dim runningVB As Boolean If IsDate(Cells(4, 1)) = True Then objDate1 = CDate(Cells(4, 1)) Else MsgBox ("Invalid Input") Exit Sub End If If IsDate(Cells(2, 4)) = True Then objDate2 = CDate(Cells(2, 4)) Else MsgBox ("Invalid Input") Exit Sub End If If IsDate(Cells(2, 5)) = True Then objDate3 = CDate(Cells(2, 5)) Else MsgBox ("Invalid Input") Exit Sub End If If objDate1 < objDate2 Then Cells(4, 3) = objDate1 Else End If If objDate1 < objDate2 Then runningVB = True Else End If If runningVB = True Then End Else End If If objDate1 < objDate3 Then Cells(4, 4) = objDate1 Else End If If objDate1 < objDate3 Then runningVB = True Else End If If runningVB = True Then End Else End If End Sub 

我已经写了它只比较D2和E2到目前为止，但它的工作原理。 有没有更简单的方法来解决这个问题？ 任何方式更简单的代码？ 因为这样，我仍然必须在每年的每个星期的每一个开始日都写下来。

Answer 1

我希望这会有所帮助。 但是你的工作表会有很大的改变

1）如果你想看其他date，你可以改变[A1] – 绿色突出显示。

2）复制并粘贴下面的公式。 对于RED =$A1+COLUMN()-3 ，对于BLUE =MID(TEXT(C2,"mmmm"),TEXT(C2,"d"),1) 。

3）您可以在各自的列中input开始date和结束date。

并使用此代码。

 Sub Example4() ' Setting up the worksheet Dim wsActive As Worksheet Set wsActive = ActiveSheet wsActive.Cells.Interior.Color = 16777215 ' Variables we will use to loop through your sheet Dim iCell As Integer ' Variables we will use to color your sheet Dim iDistance As Integer Dim iStart As Integer With wsActive ' Looping through your sheet For iCell = 3 To .Cells(.Cells.Rows.Count, 1).End(xlUp).Row iStart = .Cells(iCell, 1) - .Cells(1, 1) If Not iStart < 0 Then iDistance = .Cells(iCell, 2) - .Cells(iCell, 1) .Range(.Cells(iCell, iStart + 3), .Cells(iCell, iStart + iDistance + 3)).Interior.Color = 65535 '<~ change this to desired color iStart = 0 iDistance = 0 GoTo NextItem End If NextItem: Next End With End Sub