excel vba 示例1

Sub 设置计算名次的公式()
'首先选择待输入公式的单元格
[c2].Select
'设置C2的公式，第8参数必须用0，否则单元格中显示值而非公式
[c2].FormulaLocal = Application.InputBox("请输入计算名次的公式：", "公式", , , , , , 0)
'填充公式
Range("C2").AutoFill Destination:=Range("C2:C" & Cells(Rows.Count, 2).End(xlUp).Row)
End Sub
Sub 工作表改名2()
'声明变量, 用于获取Msgbox的返回值
Dim msg As VbMsgBoxResult
'设置一个标签
err:
On Error Resume Next '防错, 当出现错误时执行下一步
= Format(Date, "yyyy-mm-dd") '将当前工作表命名
If err.Number > 0 Then '如果存在错误(即已经有工作表的名称等于当前日期) '获取Msgbox的返回值
msg = MsgBox("存在同名工作表, 是否继续？", 2, "修改日期")
'如果用户单击"中断"则退出程序
If msg = vbAbort Then Exit Sub
'如果用户单击"忽略", 则将当前表命名为日期, 并添加左右括号
If msg = vbIgnore Then = "(" & Format(Date, "yyyy-mm-dd") & ")"
'如果用户单击"重试"则清除错误设置, 然后返回Err标签处继续执行
If msg = vbRetry Then err.Clear: GoTo err
End If
End Sub
Sub 生成月历()
On Error GoTo endd '防错：如果写入失败则动行Endd标签的语句
Dim Months As Byte
'提供一个让用户指定月份的对话框，对话框显示屏幕左上角，其上边距和左边距均为10
'inputbox反回值是String型，利用CByte转换成Byte型
Months = CByte(InputBox("请指定月份，程序将生成该月的月历", "月份", Month(Date), 10, 10))
If Months < 1 Or Months > 12 Then MsgBox "只能在1-12之间，请重新输入。

", 64, "提示": Exit Sub
Application.ScreenUpdating = False '关闭屏幕更新，加快速度
With ActiveCell
'在当前单元格显示当前日期
.Value = Format(DateSerial(Year(Date), Months, 1), "yyyy年m月d日")
'对首行合并居中
.Resize(1, 7).Merge
.HorizontalAlignment = xlCenter
' 设置标题行数据并设置为居中显示产，添加颜色
With .Offset(1, 0).Resize(1, 7)
.Formula = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") '标题
.HorizontalAlignment = xlCenter '居中显示
.Interior.ColorIndex = 15 '标示背景色
.Font.Bold = True '加粗显示
End With
With .Offset(2, 0).Resize(6, 7) '设置公式区域
'建立数组公式
.FormulaArray = "=text(IF(MONTH(" & ActiveCell.MergeArea(1).Address(0, 0) & ")<>MONTH("&ActiveCell.MergeArea(1).Address(0,0)&"-(WEEKDAY("&ActiveCell.MergeArea(1).A ddress(0, 0) & ")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""""," & ActiveCell.MergeArea(1).Address(0, 0) &"-(WEEKDAY("&ActiveCell.MergeArea(1).Address(0,0)&")-1)+{0;1;2;3;4;5}*7+{0,1,2,3,4,5,6}),""d "")"
.HorizontalAlignment = xlCenter '居中
.Value = .Value '将公式转换成值
.EntireColumn.AutoFit '自动调整列宽
End With
.Resize(8, 7).Borders().LineStyle = xlContinuous '添加边框,中间部分
'再添加外框，外框显示为加粗
.Resize(8, 7).BorderAround ColorIndex:=1, Weight:=xlThick
End With
Application.ScreenUpdating = True
Exit Sub
endd:
MsgBox "您输入的月份包括文本" & Chr(10) & "或者当前区域无法写入", 65
End Sub
Sub 新建工作表() '批量建立新表，个数等于本月天数，同时对日期命名，并建立目录Dim i As Byte, months As Byte '声明变量
'弹出一个对话框，让用户指定月份,默认显示当前月
months = InputBox("请输入月份，程序将建立该月每日日期命名的工作表", "确定月份", Month(Date))
'批量生成工作表，其个数等于指定月份的天数减去当前已有工作表个数，即确保工作表数量等于该月天数
Sheets.Add After:=Sheets(Sheets.Count), Count:=Day(DateSerial(Year(Date), months + 1, 0)) - Sheets.Count
'将所有工作表重命名，工作表名对应每日的日期
For i = 1 To Sheets.Count
Sheets(i).Name = months & "月" & i & "日" '对每个工作表命名
Next i
MsgBox "建立完毕！", 64
End Sub。