excel - 在循环中输入不匹配错误,在列中递增地添加数字

标签 excel vba

我正在创建一个为特定月/年创建时间表的子。代码基于this Microsoft example code . Microsoft 代码创建 this calendar .我正在修改代码以在单个列中插入星期几,例如 this .
我修改后的代码正确地将数字 1 插入到对应于该月的第一天的单元格中,但是添加后续日期数字的循环不起作用; Cell.Value = Cell.Offset(-1, 0).Value + 1给出类型不匹配错误。这是我修改后的代码:

Sub Calendar_Genorator1()
Dim WS As Worksheet
Dim MyInput As Variant
Dim StartDay As Variant
Dim DayofWeek As Variant
Dim CurYear As Variant
Dim CurMonth As Variant
Dim FinalDay As Variant
Dim Cell As Range
Dim RowCell As Long
Dim ColCell As Long

Set WS = ActiveWorkbook.ActiveSheet

MyInput = InputBox("Type in Month and year for Calendar ")
    If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))
       End If
       ' Prepare cell for Month and Year as fully spelled out.
       'Range("B3").NumberFormat = "d-mmmm"
       
       'Set headers
       Range("a1").Value = Application.Text(MyInput, "mmmm") & " Time Sheet"
       Range("a2") = "Day"
       Range("b2") = "Date"
       Range("c2") = "Time In"
       Range("d2") = "Time Out"
       Range("e2") = "Hours"
       Range("f2") = "Notes"
       Range("g2") = "Overtime"
       
       'Set weekdays
       Range("a3") = "Sunday"
       Range("a4") = "Monday"
       Range("a5") = "Tuesday"
       Range("a6") = "Wednesday"
       Range("a7") = "Thursday"
       Range("a8") = "Friday"
       Range("a9") = "Saturday"
       
       DayofWeek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place a "1" in cell position of the first day of the chosen month based on DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("b3").Value = 1
           Case 2
               Range("b4").Value = 1
           Case 3
               Range("b5").Value = 1
           Case 4
               Range("b6").Value = 1
           Case 5
               Range("b7").Value = 1
           Case 6
               Range("b8").Value = 1
           Case 7
               Range("b9").Value = 1
       End Select
       
       'Loop through range b3:b44 incrementing each cell after the "1" cell.
       For Each Cell In Range("b3:b44")
           RowCell = Cell.Row
           ColCell = Cell.Column
           ' Do if "1" is in column B or 2.
           If Cell.Row = 1 And Cell.Column = 2 Then
           ' Do if current cell is not in 1st column.
           ElseIf Cell.Row <> 1 Then
               If Cell.Offset(-1, 0).Value >= 1 Then
                   Cell.Value = Cell.Offset(-1, 0).Value + 1 'Type Mismatch Error here
                   ' Stop when the last day of the month has been entered.
                   If Cell.Value > (FinalDay - StartDay) Then
                       Cell.Value = ""
                       ' Exit loop when calendar has correct number of days shown.
                       Exit For
                   End If
               End If
           End If
       Next
End Sub
我将循环中的参数更改为在 B 列中增量插入天数,我怀疑错误与此有关。关于为什么我收到 Cell.Value = Cell.Offset(-1, 0).Value + 1 错误的任何想法?

最佳答案

月历

Option Explicit

Sub Calendar_Genorator1()

    Const TitleAddress As String = "A1"
    Const HeadersAddress As String = "A2"
    Const DaysAddress As String = "A3"
    Dim Headers As Variant
    Headers = Array("Day", "Date", "Time In", "Time Out", "Hours", _
                    "Notes", "Overtime")

    Dim MyInput As Variant, StartDay As Variant
    MyInput = InputBox("Type in setMonth and year for Calendar ")
    If MyInput = "" Then Exit Sub
    ' Get the date value of the beginning of inputted Month.
    StartDay = DateValue(MyInput)
    ' Check if valid date but not the first of the Month
    ' -- if so, reset StartDay to first day of Month.
    If Day(StartDay) <> 1 Then
        StartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))
    End If

    Dim ws As Worksheet
    Set ws = ActiveWorkbook.ActiveSheet
    ' Write title.
    ws.Range(TitleAddress).Value = Application.Text(StartDay, "mmmm") _
                                   & " Time Sheet"
    ' Write headers.
    ws.Range(HeadersAddress).Resize(, UBound(Headers)) = Headers
    ' Write days.
    Dim Target As Variant
    Target = getDDDD_D_US(Month(StartDay), Year(StartDay))
    ws.Range(DaysAddress).Resize(UBound(Target), UBound(Target, 2)).Value = Target

End Sub

Function getDDDD_D_US(setMonth As Long, setYear As Long)
    Dim DaysData As Variant
    DaysData = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", _
                     "Friday", "Saturday")
    Dim Result As Variant
    ReDim Result(1 To 42, 1 To 2)
    ' Write DDDD column.
    Dim i As Long, j As Long, k As Long
    For i = 1 To 6
        k = (i - 1) * 7 + 1
        For j = 0 To 6
            Result(k + j, 1) = DaysData(j)
        Next j
    Next i
    ' Write D column.
    Dim Current As Date
    Current = DateSerial(setYear, setMonth, 1)
    i = Weekday(Current)
    For i = i To i + 27
        Result(i, 2) = Day(Current)
        Current = Current + 1
    Next i
    For i = i To i + 2
        If Month(Current) = setMonth Then
            Result(i, 2) = Day(Current)
            Current = Current + 1
        End If
    Next i
    getDDDD_D_US = Result
End Function

关于excel - 在循环中输入不匹配错误,在列中递增地添加数字,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/62123871/

相关文章:

VBA 将结果全部显示在第一张纸上,而不是相关的纸上?

excel - 从 Excel VBA 运行 Powerpoint sub

excel - Application.Evaluate 与 Activesheet.Evaluate

excel - 根据列中的字符串有条件地折叠Excel行?

ios - 从电子表格或数据库文件中的大型数据集创建字典

mysql - 参数未添加到 INSERT 语句 VBA 的 ADO 字符串

excel - 用户表单:在文本框中继续运行总计

mysql - 如何进行选择行的谷歌查询?

excel - 如何使用 SAS 从 Excel 中读取格式不正确的列

excel - "Application"作为 Excel VBA 中的默认对象呢?