求EXCEL VBA高手注解

excel VBA语句注释~

1. Sub 计算()
Dim a as Integer ；定义变量 a 为 整数型
a=Val(InputBox(“请输入一整数a”) ；将对话框中输入的值转化为数值并赋值给变量a
If a>=0 Then ；条件语句，如果a大于等于零
a=a+10 ；则，变量a等于原变量值+10
Else ；否则a小于零
a=-a+10 ；变量a等于10-变量a
End ；条件语句结束
Sheet1.Activate ；激活sheet1表
Cells(1, 1) = a ；将变量a的值写入单元格A1
End Sub ；过程结束

2.Sub color()
For k = 1 To 7 ；循环语句，执行7次
c = "A" & k ；确定单元格，如A1 、A2
Range(c).Select ；选定单元
Selection.Interior.ColorIndex = k ；给选定的单元格标色
Next
End Sub ； 该过程执行完后会给A1Z至A7单元格表上7种颜色。

Private Sub CommandButton1_Click()
Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Set OldSheet = ActiveSheet

Dim N As String
Do While True
N = InputBox("请输入一个日期")
If IsDate(N) = False Then
MsgBox "日期格式不合法", vbCritical
Else
Exit Do
End If
Loop

Dim TimeLine As Date
TimeLine = DateAdd("m", -1, CDate(N))
'''''''''''''''''''''''''''''''''''(5)
ActiveSheet.Columns(1).ColumnWidth = 9
ActiveSheet.Columns(2).ColumnWidth = 8.13
ActiveSheet.Columns(3).ColumnWidth = 10.5
ActiveSheet.Columns(4).ColumnWidth = 6.5
ActiveSheet.Columns(5).ColumnWidth = 6.75
ActiveSheet.Columns(6).ColumnWidth = 8.85

''''''''''''''''''''''''''''''''''(4)
Dim OldNewName As String
OldNewName = Year(TimeLine) & "年" & Month(TimeLine) & "月" & "文本2"

Dim i As Long
For i = 1 To Worksheets.Count
If Worksheets(i).Name = OldNewName Then
MsgBox "命名失败，使用默认名称", vbCritical
Exit For
End If
Next i
If i > Worksheets.Count Then
OldSheet.Name = OldNewName
End If
OldSheet.Range("A1") = OldNewName
OldSheet.Range("A1").Font.Bold = True
OldSheet.Range("A1").HorizontalAlignment = xlCenter
''''''''''''''''''''''''''''''''''''(1)
Dim ColNames As String
Dim ColArr() As String
Dim DataLines As Long, DataCols As Long, SortRg As Range
ColNames = "A,B,C" '列名，用逗号分隔，最多3列
ColArr = Split(ColNames, ",")
DataLines = [A65535].End(xlUp).Row
DataCols = [IV3].End(xlToLeft).Column
Set SortRg = Range(Cells(3, 1), Cells(DataLines, DataCols))
SortRg.Select
Select Case UBound(ColArr)
Case 0
SortRg.Sort key1:=Range(ColArr(0) & "2")
Case 1
SortRg.Sort key1:=Range(ColArr(0) & "2"), key2:=Range(ColArr(1) & "2")
Case 2
SortRg.Sort key1:=Range(ColArr(0) & "2"), key2:=Range(ColArr(1) & "2"), key3:=Range(ColArr(2) & "2")
End Select

'''''''''''''''''''''''''''''''(2)
Set NewSheet = Worksheets.Add
NewSheet.Move After:=OldSheet
Dim NewName As String
NewName = Year(CDate(N)) & "年" & Month(CDate(N)) & "月"
NewName = NewName & "文本1" '根据自己需要修改


For i = 1 To Worksheets.Count
If Worksheets(i).Name = NewName Then
MsgBox "命名失败，使用默认名称", vbCritical
Exit For
End If
Next i
If i > Worksheets.Count Then
NewSheet.Name = NewName
End If

'''''''''''''''''''''''''(3)

OldSheet.Range("A1", OldSheet.Cells(2, DataCols)).Copy NewSheet.Range("A1", NewSheet.Cells(2, DataCols))
NewSheet.Range("A1") = NewName
Dim k As Long
k = 3
i = 3
While i <= DataLines
If CDate(OldSheet.Cells(i, 1)) > TimeLine Then '日期判断条件
OldSheet.Range("A" & i, OldSheet.Cells(i, DataCols)).Copy NewSheet.Range("A" & k, NewSheet.Cells(k, DataCols))
OldSheet.Range("A" & i, OldSheet.Cells(i, DataCols)).Delete xlShiftUp
i = i - 1
DataLines = DataLines - 1
k = k + 1
End If
i = i + 1
Wend
ActiveSheet.Columns(1).ColumnWidth = 9
ActiveSheet.Columns(2).ColumnWidth = 8.13
ActiveSheet.Columns(3).ColumnWidth = 10.5
ActiveSheet.Columns(4).ColumnWidth = 6.5
ActiveSheet.Columns(5).ColumnWidth = 6.75
ActiveSheet.Columns(6).ColumnWidth = 8.85
End Sub

Sub Macro8() 建筑、安装删除空行
Dim i, j As Integer 定义整数
Dim A(2), B, C, D, E As String 定义字符串

A(0) = "建筑"
A(1) = "安装"

For i = 0 To 1 Step 1

Sheets(A(i)).Select 选择建筑表
For j = 430 To 6 Step -1 （为什么要这样设置） 由最大行数递减删除，可以避免由最小行数开始删除导致总体行数变动，要再次计算行数的麻烦。
B = "C" & j
C = "O" & j
Select Case A(i) 选择判断
Case "建筑"
D = j - 1 & ":" & j + 24
E = "小 计"
Case "安装"
D = j - 1 & ":" & j + 28
E = "小 计"
End Select

If Sheets(A(i)).Range(B) = E Then 判断是否相等
If Sheets(A(i)).Range(C) Then ？？？ 判断啥
怎么啥都没直接else，没有具体内容不知道这两句在干吗
Else
Sheets(A(i)).Rows(D).Select 选取要删除的行范围
Selection.Delete Shift:=xlUp 删除
End If
End If
Next
Sheets(A(i)).Rows("6:437").Select 选取区域
Selection.AutoFilter 自动筛选
Selection.AutoFilter Field:=19, Criteria1:="标准定额" 条件1
Selection.AutoFilter Field:=15, Criteria1:="=" 条件2
Sheets(A(i)).Rows("9:437").Select 选取行区域
Selection.Delete Shift:=xlUp 删除选取区域
Selection.AutoFilter 取消自动筛选
Next
End Sub

---

求EXCEL VBA高手注解视频