abhs.vba

Sub test1()
    Dim rowGap As Integer, i As Integer, j As Integer, k As Integer, h As Integer, n As Integer, m As Integer
    Dim columns(1 To 15) As String, week(2 To 15) As String
    Dim weekRange As range
    Dim d As Date
    Dim col As String
    Dim dis_res1 As Integer
    Dim rem_res1 As Integer
    Dim times(1 To 5) As Integer
    Dim rowGap2 As Integer
    
    
    
    columns(1) = "B"
    columns(2) = "C"
    columns(3) = "D"
    columns(4) = "E"
    columns(5) = "F"
    columns(6) = "G"
    columns(7) = "H"
    columns(8) = "I"
    columns(9) = "J"
    columns(10) = "K"
    columns(11) = "L"
    columns(12) = "M"
    columns(13) = "N"
    columns(14) = "O"
    columns(15) = "P"
    
    week(2) = "一"
    week(4) = "二"
    week(6) = "三"
    week(8) = "四"
    week(10) = "五"
    week(12) = "六"
    week(14) = "日"
    
    times(1) = 1
    times(2) = 3
    times(3) = 7
    times(4) = 14
    times(5) = 29
    
    rowGap = 2
    d = InputBox("请输入一个日期(YYYY-MM-dd)：", "日期输入", #9/30/2015#)
    
    k = 1
    col = ""
    h = 1
    Application.DisplayAlerts = False
    For i = 1 To 55
        ' 设置“周”的表格区域
        Set weekRange = range(columns(1) & CStr(k) & ":" & columns(1) & CStr(k + 7))
        weekRange.MergeCells = True
        With weekRange
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            With .Font
                .Size = 16
                .Bold = True
            End With
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThisWeek
            End With
            .Interior.ColorIndex = 40
            
        End With
        
        weekRange.Value = "第" & CStr(i) & "周"
        ' 设置“周”与“周”表格区域之间的间隔
        range("A" & CStr(k + 8) & ":P" & CStr(k + 9)).MergeCells = True
        
        For j = 2 To 15
        
            With range(columns(j) & CStr(k))
                .Interior.ColorIndex = 41
                With .Borders
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
            End With
            
            ' 生成星期和日期
            If week(j) <> "" Then
                range(columns(j) & CStr(k)).Value = week(j)
                
                With range(columns(j) & CStr(k + 1))
                    .Interior.ColorIndex = 41
                    With .Borders
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                    End With
                End With
                
                ' 设置复习次数
                For n = 1 To 6
                    range(columns(j) & CStr(k + n + 1)).Value = 7 - n
                Next
            Else
                If col = "" Then
                    range(columns(j) & CStr(k)).Value = d
                    range(columns(j) & CStr(k)).Locked = False
                ElseIf j = 3 Then
                    range(columns(j) & CStr(k)).Value = "=" & col & CStr(h) & "+1"
                    h = k
                Else
                    range(columns(j) & CStr(k)).Value = "=" & col & CStr(k) & "+1"
                End If
                
                
                col = columns(j)
            ' end
            
            
                
            End If
            
            
        Next
        
        k = k + rowGap + 8
        
        
        
    Next
    
    Application.DisplayAlerts = True
    
End Sub




Sub test2()
    Dim i As Integer, j As Integer, rowGap As Integer, k As Integer, n As Integer
    Dim columns(1 To 7) As String, times(1 To 5) As Integer
    Dim dis_res As Integer, rem_res As Integer, res As Integer, gap As Integer
    Dim str_rang As String
    Dim rang As range
    
    columns(1) = "D"
    columns(2) = "F"
    columns(3) = "H"
    columns(4) = "J"
    columns(5) = "L"
    columns(6) = "N"
    columns(7) = "P"
    
    times(1) = 1
    times(2) = 3
    times(3) = 7
    times(4) = 14
    times(5) = 29
    
    k = 1
    rowGap = 2
    
    For i = 1 To 55
        For j = 1 To 7
            str_rang = columns(j) & CStr(k + 1)
            Set rang = range(columns(j) & CStr(k + 1))
            rang.Locked = False
            For n = 1 To 5
                res = j + times(n)
                dis_res = Int(res / 7)
                rem_res = res Mod 7
                If res <= 7 Then
                    range(columns(res) & CStr(k + 8 - n)).Value = "=" & str_rang
                ElseIf dis_res >= 1 And rem_res > 0 Then
                    gap = (rowGap + 8) * dis_res + k
                    range(columns(rem_res) & CStr(gap + 8 - n)).Value = "=" & str_rang
                ElseIf dis_res >= 1 And rem_res = 0 Then
                    gap = (rowGap + 8) * (dis_res - 1) + k
                    range(columns(7) & CStr(gap + 8 - n)).Value = "=" & str_rang
                End If
                
            Next
        Next
        
        k = k + rowGap + 8
        
    Next


End Sub


Sub test3()
    Dim i As Integer, j As Integer, k As Integer, n As Integer, m As Integer, rowGap As Integer
    Dim columns(1 To 8) As String, col_index As Integer, res As Integer
    Dim r As range
    
    k = 1
    m = 1
    rowGap = 2
    
    For i = 1 To 55
        
        For j = 0 To 7
            col_index = 6
            ' 内容背景颜色
            If j = 1 Then
                col_index = 0
            ' 日期和星期的背景色
            ElseIf j = 0 Then
                col_index = 41
            End If
            
            For n = 3 To 16
                res = n Mod 2
                If j = 1 And res <> 0 Then
                    col_index = 41
                ElseIf j = 1 And res = 0 Then
                    col_index = 0
                End If
                
                With Cells(j + k, n)
                    With .Borders
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    .HorizontalAlignment = Excel.xlCenter
                    .VerticalAlignment = xlCenter
                    .Interior.ColorIndex = col_index
                    
                    If res = 0 Then
                        With .Borders(xlEdgeRight)
                            .LineStyle = xlContinuous
                            .Weight = xlThisWeek
                            .ColorIndex = xlAutomatic
                        End With
                    End If
                    
                    If j = 0 Then
                        With .Borders(xlEdgeTop)
                            .LineStyle = xlContinuous
                            .Weight = xlThisWeek
                            .ColorIndex = xlAutomatic
                        End With
                        If n = 3 Then
                            With .Borders(xlEdgeLeft)
                                .LineStyle = xlContinuous
                                .Weight = xlThisWeek
                                .ColorIndex = xlAutomatic
                            End With
                        End If
                    
                    ElseIf j = 7 Then
                        With .Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThisWeek
                            .ColorIndex = xlAutomatic
                        End With
                        If n = 3 Then
                            With .Borders(xlEdgeLeft)
                                .LineStyle = xlContinuous
                                .Weight = xlThisWeek
                                .ColorIndex = xlAutomatic
                            End With
                        End If
                    End If
                    
                    
                End With
            Next
        Next
                
        k = k + rowGap + 8
    Next
    
    
End Sub