2017-03-04 79 views
1

我正在尝试做什么; 我想要一个日历,当约会完成时,我可以把约会添加到我的约会收取的金额作为收入,也可以添加当我购买耗材的一天,我买他们多少,并将其作为开支。然后,将这些信息(收入/费用)填充到另一个标签中,这些标签可以打印出来并纳入会计核算。擅长使用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

+0

你是什么意思?“我需要他们每次跳过两列”? –

+0

如果我运行你的代码(实际上需要改变以获得一天),使用3/1/2017的日期,然后它将第4行(col GV)中的1至16,然后第12行中的17-31 col DR)。你真的想要它超过7天吗? –

+0

抱歉张贴了错误的图片。它只会是7天,但我需要第2天,第4天和第3天是第7天,等等。 –

回答

0

我修改你的代码,我相信它的工作原理,只要你想。注:(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 
+0

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