jkluio668
10/18/2017 - 4:33 PM

fill_date1

'[1]vba:间隔行,填入递减的文本日期
Sub fill_date1() '间隔15行,填入递减的文本日期
    startday = "171231" '起始日期
    allday = 60  '←,需添加的天数
    betweenrday = 3 '间隔的天数
    betweenrow = 15 '←,间隔的行数
    beginrow = 651 '从哪行开始
    '-----
    Dim str1
    startday = DateSerial(Mid(startday, 1, 2), Mid(startday, 3, 2), Mid(startday, 5, 2)) '字符串转为日期
    'Columns(1).ClearContents
    
    Columns(1).ColumnWidth = 7
    Columns(1).NumberFormatLocal = "G/通用格式"
    Columns(1).NumberFormatLocal = "yymmdd" '不能不写上一行而直接写一行,因为将无法变为想要的文本格式。需通过“通用格式”,再“日期格式”,再“文本格式”的写法,来实现
    ' Cells(1, 1) = "2017/11/11" '先填入第一行,最后再删除
    '插入行
    For i = 1 To Int(allday / betweenrday) * betweenrow
        Rows(beginrow & ":" & beginrow).Insert Shift:=xlDown
    Next
    '填入日期
    For i = 1 To allday Step betweenrday
        row1 = (i - 1) * betweenrow / betweenrday + beginrow
        Cells(row1, 1) = startday - i + 1
        '---
        str1 = Cells(row1, 1).Text
        Cells(row1, 1).NumberFormatLocal = "@"
        Cells(row1, 1) = str1
        '---
    Next
    Columns(1).NumberFormatLocal = "@"
    Columns(1).ColumnWidth = 3.4 '调节宽度,刚好让手机中显示露出月份而不露出年
    Columns(1).HorizontalAlignment = Excel.xlRight
    'Cells(1, 1) = ""
    Add_up_border
End Sub
Sub Add_up_border() '对每个日期段,添加分割的横线
    For i = [a65536].End(xlUp).Row To 2 Step -1
        If Cells(i, 1) <> "" Then
            Rows(i & ":" & i).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            Selection.Borders(xlEdgeLeft).LineStyle = xlNone
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            'Selection.Borders(xlEdgeBottom).LineStyle = xlNone
            Selection.Borders(xlEdgeRight).LineStyle = xlNone
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        End If
    Next
End Sub
'[1]选定单元格开始,添加日期相关的数据有效性



[1]字符串转日期格式
d1 = InputBox$("input date like “180101”")
s = "20" & Left(d1, 2) & "/" & Mid(dstart, 2+1, 2) & "/" & Mid(dstart, 2+2+1, 2)
b = CVDate(s)
msgbox DateSerial(Year(b), Month(b), Day(b))

[2]函数:DateSerial
DateSerial(year,month,day)