'[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)