擅長使用VBA在日曆中輸入日期

我正在嘗試做什麼; 我想要一個日曆，當約會完成時，我可以把約會添加到我的約會收取的金額作爲收入，也可以添加當我購買耗材的一天，我買他們多少，並將其作爲開支。然後，將這些信息（收入/費用）填充到另一個標籤中，這些標籤可以打印出來並納入會計覈算。擅長使用VBA在日曆中輸入日期

我正在處理日曆部分，但在出現在正確列中的日子有問題。這些日子裏，每個箱子都有3列，這樣我就可以稍後添加數據。我可以在日曆中填充日期，但我需要它們每次跳過兩列，但它們不是。

我正在包括代碼和它在這個時候出現的剪輯。

Sub CreateCalendar() 
Dim csheet As Worksheet 
Set csheet = ThisWorkbook.Sheets("Sheet2") 

selDate = [b1] 
fMon = DateSerial(Year(selDate), Month(selDate), 1) 
lMon = CDate(Application.WorksheetFunction.EoMonth(fMon, 0)) 

stRow = 4 

'clear last cal 
Rows(4).ClearContents 
Rows(10).ClearContents 
Rows(16).ClearContents 
Rows(22).ClearContents 
Rows(28).ClearContents 
Rows(34).ClearContents 


'determine what weekday 1st is. . . 
If Weekday(fMon) = 1 Then 
    stCol = 4 
ElseIf Weekday(fMon) = 4 Then 
    stCol = 7 
ElseIf Weekday(fMon) = 7 Then 
    stCol = 10 
ElseIf Weekday(fMon) = 10 Then 
    stCol = 13 
ElseIf Weekday(fMon) = 13 Then 
    stCol = 16 
ElseIf Weekday(fMon) = 16 Then 
    stCol = 19 
ElseIf Weekday(fMon) = 19 Then 
    stCol = 22 
End If 

For x = 1 To Day(lMon) 
If FirstT = Empty Then 
    csheet.Cells(stRow, stCol) = fMon 
    FirstT = 1 
Else 
    fMon = fMon + 1 
    csheet.Cells(stRow, stCol) = fMon 
End If 

If stCol = 22 Then 
    stCol = 4 
    stRow = stRow + 8 
Else 
    stCol = stCol + 1 
End If 

Next x 

End Sub

Calendar

來源

2017-03-04 Allen Smith

你是什麼意思？「我需要他們每次跳過兩列」？ –

如果我運行你的代碼（實際上需要改變以獲得一天），使用3/1/2017的日期，然後它將第4行（col GV）中的1至16，然後第12行中的17-31 col DR）。你真的想要它超過7天嗎？ –

抱歉張貼了錯誤的圖片。它只會是7天，但我需要第2天，第4天和第3天是第7天，等等。 –

我修改你的代碼，我相信它的工作原理，只要你想。注：（1）我對測試日期進行了硬編碼;您需要將其更改回（2）您的代碼爲'ClearContents'每6行不同於您的代碼以增加8行。我設置了6行。（3）您可以刪除我在第一行中放置日期名稱的位置。

Option Explicit 

Sub CreateCalendar() 
Dim csheet As Worksheet 
Dim selDate As Date 
Dim fMon As Long 
Dim lMon As Long 
Dim stRow As Integer 
Dim stCol As Integer 
Dim FirstT As Integer 
Dim x  As Integer 
Dim iColOffset As Integer 



    Set csheet = ThisWorkbook.Sheets("Sheet2") 

    selDate = #1/1/2017#  '[b1] 
    fMon = DateSerial(Year(selDate), Month(selDate), 1) 
    lMon = CDate(Application.WorksheetFunction.EoMonth(fMon, 0)) 

    iColOffset = 4  ' Set default starting column 
    'I added the following code so I could keep track... you can delete 
    Cells(1, iColOffset) = "Sunday" 
    Cells(1, iColOffset + 3) = "Monday" 
    Cells(1, iColOffset + 6) = "Tuesday" 
    Cells(1, iColOffset + 9) = "Wednesday" 
    Cells(1, iColOffset + 12) = "Thursday" 
    Cells(1, iColOffset + 15) = "Friday" 
    Cells(1, iColOffset + 18) = "Saturday" 

    stRow = 4   ' Starting Row 

    'clear last cal 
    Rows(4).ClearContents 
    Rows(10).ClearContents 
    Rows(16).ClearContents 
    Rows(22).ClearContents 
    Rows(28).ClearContents 
    Rows(34).ClearContents 


    'determine what weekday 1st is. . . 
    Debug.Print "First DOW = " & Weekday(fMon) 
    stCol = Weekday(fMon)  ' Set starting column 
' If Weekday(fMon) = 1 Then 
'  stCol = 1 
' ElseIf Weekday(fMon) = 2 Then 
'  stCol = 2 
' ElseIf Weekday(fMon) = 3 Then 
'  stCol = 3 
' ElseIf Weekday(fMon) = 10 Then 
'  stCol = 4 
' ElseIf Weekday(fMon) = 13 Then 
'  stCol = 5 
' ElseIf Weekday(fMon) = 16 Then 
'  stCol = 6 
' ElseIf Weekday(fMon) = 19 Then 
'  stCol = 7 
' End If 

    For x = 1 To Day(lMon) 
     If FirstT = Empty Then 
      csheet.Cells(stRow, iColOffset + (stCol * 3) - 3) = Day(CDate(fMon)) 
      FirstT = 1 
     Else 
      fMon = fMon + 1 
      csheet.Cells(stRow, iColOffset + (stCol * 3) - 3) = Day(CDate(fMon)) 
     End If 

     'Debug.Print iColOffset + (stCol * 3) - 3 
     If iColOffset + (stCol * 3) - 3 = 22 Then 
      stCol = 1 
      ' *** NOTE!! Your code doesn't match. 
      ' Above, you clear every 6 Rows (4, 10, 16, 22...), but here you are incrementing by 8. 
      ' Which is it? 
      'stRow = stRow + 8 
      stRow = stRow + 6    ' I changed to 6 to match what you clear 
     Else 
      stCol = stCol + 1 
     End If 
    Next x 

End Sub

來源

2017-03-04 20:44:24

非常感謝您在下一部分工作。 –

擅長使用VBA在日曆中輸入日期

回答

相關問題