Excel的VBA - 輸入開始和結束日期爲日曆

Question

目前我正在試圖想出如何編寫VBA腳本，它會掃描某些列開始的項目日期的想法，並把當天在各自的小區日曆。爲了使事情更清楚這裏是它應該是什麼樣子基本看：

正如你可以看到日曆包含的幾個月以及每一個新的一週開始天（星期一）。例如：第4行項目從2017年4月10日開始。腳本應該掃描該單元格，並用10填充D4。第5行中的項目從5月3日開始，因此它應該填寫值爲3的G5。對於所有其他行和結束日期以及。

到目前爲止，我有想法，讓每一個細胞的宏觀掃描和比較，在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 

但是，你可以想像這將是相當長的一段一段代碼一個會寫，你不應該把它寫在一年中的每一天，然後複製它結束日期，它不會很有效率。

有誰有一個想法，這怎麼會在一個巧妙的方法來完成？任何幫助表示讚賞。提前致謝。

---

EDIT1： 所以，我試圖實現什麼在評論中提到的一樣好，我可以。這是我到目前爲止：

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）如果您想查看其他日期，可以更改[A1] - 以綠色突出顯示。

2）複製和粘貼下面的公式。對於RED=$A1+COLUMN()-3，爲BLUE=MID(TEXT(C2,"mmmm"),TEXT(C2,"d"),1)。

3）您可以輸入開始和結束日期在各自的列。

，並使用此代碼。

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