Execl宏程序总结讲解

宏
Sub Macro1()
'
' Macro1 Macro
' 宏由 lenovo 录制，时间: 2012/9/19
'
' 快捷键: Ctrl+z
'
k = 1 '循环变量
Do While k <= Worksheets.Count '工作表数量
Sheets(k).Select '逐个设置工作为当前工作表
Rem ====确定真正的最后一行
Rem ====先用定位的方法找到工作表中的最后一个单元格
Selection.SpecialCells(xlCellTypeLastCell).Select
flag = False
Rem ====向上循环判断是否是空行
Do While flag = False
Rem ====如果是第一行，退出循环，否则后面的Offset语句向上移动时会出错 If ActiveCell.Row = 1 Then
Exit Do
End If
Rem ====判断当前行是不是空行
Selection.End(xlToLeft).Select
temp1 = IsEmpty(ActiveCell.Value)
Selection.End(xlToRight).Select
temp2 = IsEmpty(ActiveCell.Value)
If temp1 = True And temp2 = True Then
Rem ====如果是空行则选择上一行
Selection.Offset(-1, 0).Select
Else
Rem====如果不是空行，说明已经是真正的最后一行，退出循环 flag = True
Exit Do
End If
Loop
Rem====把最后一行的行号赋给一个变量
row_last = ActiveCell.Row
Cells(row_last, 1).Select
k = k + 1
Loop
End Sub
Sub Macro1()
' Macro1 Macro
' 宏由 lenovo 录制，时间: 2012/9/19
'
' 快捷键: Ctrl+z
'
k = 1 '循环变量
Do While k <= Worksheets.Count '工作表数量
Sheets(k).Select '逐个设置工作为当前工作表
endrow = Range("B65536").End(xlUp).Row
For i = endrow To 6 Step -1
If Cells(i, 3) = "" And Cells(i, 5) = "" Then Cells(i, 2) = "" Next k = k + 1
Loop
End Sub Sub Macro6()
'
' Macro6 Macro
' 宏由 lenovo 录制，时间: 2012/9/24
'
' 快捷键: Ctrl+x
'
k = 1 '循环变量
MsgBox Worksheets.Count
Do While k <= Worksheets.Count '工作表数量
Sheets(k).Select '逐个设置工作为当前工作表
Range("C3:J3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("A6:K37").Select With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("A6:M37").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone With
Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic End With
With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With
With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin
.ColorIndex = xlAutomatic End With
Columns("A:A").ColumnWidth = 3 Columns("B:B").ColumnWidth = 6.63
Columns("E:E").ColumnWidth = 5.88 Columns("F:F").ColumnWidth = 6
Columns("I:I").ColumnWidth = 7.5 Columns("J:J").ColumnWidth = 7.75
Columns("M:M").ColumnWidth = 7.13
Rows("1:1").RowHeight = 15
Rows("2:2").RowHeight = 44.25 Rows("4:4").RowHeight = 24.75
Rows("6:6").RowHeight = 63
Rows("6:6").RowHeight = 66
For i = 6 To 36
Rows(i & ":" & i).RowHeight = 16.5 Next
k = k + 1
Loop
End Sub Sub Macro3()
'
' Macro3 Macro
' 宏由 lenovo 录制，时间: 2012/9/23 '
' 快捷键: Ctrl+z
'
k = 1 '循环变量
Do While k <= Worksheets.Count '工作表数量 Sheets(k).Select '逐个设置工作为当前工作表
For i = 36 To 6 Step -1
If Cells(i, 8) <> "" Then
Cells(i, 5) = ""
Cells(i, 3) = ""
Else
Cells(i, 2) = ""
Cells(i, 5) = ""
Cells(i, 3) = ""
End If
Next
k = k + 1
Loop
End Sub
Sub Macro6()
'
' Macro6 Macro
' 宏由 lenovo 录制，时间: 2012/9/19 '
' 快捷键: Ctrl+z
'
k = 1 '循环变量
Do While k <= Worksheets.Count '工作表数量 Sheets(k).Select '逐个设置工作为当前工作表 If Cells(3, 9) <> "" Then
Sheets(k).Name = Cells(3, 9)
Else
If Cells(3, 9) <> "" Then
Sheets(k).Name = Cells(3, 10)
Else
Exit Sub
End If
End If
k = k + 1
Loop
End Sub
Sub Macro1()
'
' Macro1 Macro
' 宏由 lenovo 录制，时间: 2012/9/20 '
' 快捷键: Ctrl+z
'
k = 1 '循环变量
Do While k <= Worksheets.Count '工作表数量 Sheets(k).Select '逐个设置工作为当前工作表
endrow = Range("C36").End(xlUp).Row
A = 0
B = 0
If endrow > 8 Then
For i = 16 To 6 Step -1
If A = 0 Then
If Cells(i, 3) <> "" Then Cells(i, 3).Select
A = Selection.Value End If
Else
If Cells(i, 3) <> "" Then Cells(i, 3).Select
B = Selection.Value End If
If B > A Then
Exit Sub
End If
End If
Next
End If
k = k + 1
Loop
End Sub
If Err.Number <> 0 Then Err.Clear
On Error Resume Next
set r=cells.find()
if r is nothing then
exit sub
else
你的代码
end if
插入一个模块粘贴以下代码 Sub SS()
Dim MyFile, MyPath As String
Dim rng As Range
istr = ThisWorkbook.Sheets("sheet1").Range("A1").Value MyPath = "C:\"
arr = Split("456.xls,789.xls", ",")
n = 0
Do
On Error Resume Next
MyFile = arr(n)
Workbooks.Open (MyPath & "\" & MyFile)
Set rng = Workbooks(MyFile).Sheets("sheet1").UsedRange.Find(istr) If Not rng Is Nothing Then
ThisWorkbook.Sheets("sheet1").Rows(2).Value =
Workbooks(MyFile).Sheets("sheet1").Rows(rng.Row).Value
Workbooks(MyFile).Close
Exit Sub
End If
Workbooks(MyFile).Close
n = n + 1
Loop While n <= 1
MsgBox "Nothing"
End Sub
Range("A1").Select
ActiveCell.FormulaR1C1 = "6/1/2011"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A30"), Type:=xlFillDefault
Range("A1:A30").Select
ActiveWindow.SmallScroll Down:=-9
Selection.NumberFormatLocal = "m/d;@"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
属性的调整
Range("I5").Select
With Selection.Font
.Name = "宋体"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
J5格涮成H5
Range("J5").Select
Selection.Copy
Range("H5").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
外框有没有
Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
连续选择
Range("H5:M5，2:2").Select第二行
间隔选择
Range("F17,H17,H21,E23,E16,C16,C23").Select
运行宏程序
Application.Run "Book1.xls!Macro1"
新建表格
= "xinjian"
当前数据
Selection.Value
当前数据 = ActiveCell
Row_Max = Worksheets(1).UsedRange.Rows.最大行数Dim ar As Range
For Each ar In Selection.Areas 选择的区域
ar.Value = ar.Value 公式数值转换成数值
Next ar
ActiveWindow.SmallScroll Down:=3 鼠标滚动Range("C6:C36").Select
Selection.NumberFormatLocal = "0.0_ "一位有效数字数组
Dim x As Long, y As Long
Dim arr(1 To 10, 1 To 3) '创建一个可以容下10行3列的数组空间
For x = 1 To 4
For y = 1 To 3
arr(x, y) = Cells(x, y) '通过循环把单元格区域a1:c4的数据装进数组中 Next y Next x
MsgBox arr(4, 3) '根据提供的行数和列数显示数组
arr(1, 2) = "我改一下试试" '你可以随时修改数组内指定位置的数据
MsgBox arr(1, 2)
AR R = Application.Transpose(Range("a1:a3")) ‘用转置的方法，把单元格一列数据转换成一维数组
Sub test()
Dim x(1 To 11) As Single
Dim y(1 To 11) As Single
Dim i As Integer
n = 1
For i = -10 To 10 Step 2
x(n) = i
Cells(n, 8) = x(n)
y(n) = x(n) ^ 3 + x(n) ^ 2 + x(n)
Cells(n, 9) = y(n)
n = n + 1
Next
End Sub
最小化
Application.WindowState = xlMinimized
取得焦点
Windows("4月自卸汽车IAI-062xls.xls").Activate
选中当前（活动）单元格左边第10个单元格。

ActiveCell.Offset(0, -10) range("A1").offset(1)即向下偏移一行
Selection.offset(0,1)= Workbooks("Book1.xls").worksheets("sheet1").Range("A1") 选择第三个深水井，选择BVB903
Selection.AutoFilter Field:=3, Criteria1:="BVB903"
给活动的单元格赋值
Range("A1").Select
ActiveCell.FormulaR1C1 = <值>
得到指定单元格中的值
Range("<单元格地址>").Text
插入单元格
Selection.Insert Shift:=xlToRight ‘在当前选中单元格的位置插入单元格并将当前选中的单元格向右移动
Selection.Ins ert Shift:=xlDown ‘在当前选中单元格的位置插入单元格并将当前选中的单元格向下移动
Selection.EntireRow.Insert ‘在当前选中单元格的上面插入一行
Selection.EntireColumn.Insert ‘在当前选中单元格的左侧插入一列
设置字体名称和大小
= <字体名称>
Selection.Font.Size = <字号>
Selection.Font.Bold = <True / False> ‘加粗
Selectio n.Font.Italic = <True / False> ‘斜体
Selection.Font.ColorIndex = <0到56之间的数字>
Selection.Font.Color = <RGB值>
清空选中单元格里的内容
Selection.ClearContents
删除选中的单元格
Selection.Delete <XlDirection值>
Selection.EntireRow.Delete
Selection.EntireColumn.Delete
得到当前EXCEL的文件名
Thi sWorkbook.Path ‘文件路径
‘文件名
ThisWorkbook.FullName ‘全路径
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & s & ".xls") 添加批注
Range("A1").AddComment ("Writes the content in here!")
Range("B1").Comment.Text Text:= "Writes the content in here!"修改批注显示/隐藏批注
Comment.Visible = <True/False>
删除批注
ClearComments
Selection.Cut ‘剪切
Selection.Copy ‘复制
ActiveSheet.Paste ‘粘贴
公式赋值
ActiveCell.Formula="=AVERAGE(R[-6]C[-4]:R[-2]C[-4])"
Range("E10").Formula="=SUM(Sheet1!R1C1:R4C1)"
Worksheets("Sheet1").ActiveCell.Formula="=Max('1-1剖面'!D3:D5)"
Dim fenshu As Integer
fenshu = 60
Select Case fenshu ‘ 给出条件分级别选择
Case 90 To 100 MsgBox "优异" Case 75 To 89
MsgBox "优秀"
Case 60 To 74
MsgBox "及格"
Case Else
MsgBox "不及格"
End Select
---------------------------
Selection.AutoFilter Field:=3, Criteria1:=">=0", Operator:=xlAnd
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
（AutoFilter）自动筛选（Field:=3）所选区域右边第三列（Criteria1:=">=0",）不小于0 的数，Operator:=xlAnd表示与后面筛选条件的关系为并列关系，在这里可删去
Selection.AutoFilter Field:=3, Criteria1:=">=0", Operator:=xlAnd
筛选现在选定单元格右边第三列中所有>=0 的值
Cells.Select 选择所有单元格
Selection.SpecialCells(xlCellTypeVisible).Select
选择已选区域的可见区域
这两句表示选择可见区域
内容的剪切
Range("C8").Select
Selection.Cut Destination:=Range("C10") 复制
Range("C10").Select
Selection.Copy Destination:=Range("D10") --------------------
Range("J5").Select
Selection.Copy复制
Range("J13").Select
ActiveSheet.Paste粘贴
With Selection.Interior表明
.ColorIndex = 6
.Pattern = xlSolid
End With
Range("A1:C1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For k = 1 To 500
For i = 1 To 15
Cells(1, i).Select
Selection.Interior.ColorIndex = xlNone Cells(1, i + 3).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 15 To 17
Cells(1, i).Select
Selection.Interior.ColorIndex = xlNone Cells(i - 13, 18).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 1 To 27
Cells(i, 18).Select
Selection.Interior.ColorIndex = xlNone Cells(i + 3, 18).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 27 To 29
Cells(i, 18).Select
Selection.Interior.ColorIndex = xlNone Cells(30, 44 - i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 1 To 15
Cells(30, 19 - i).Select
Selection.Interior.ColorIndex = xlNone Cells(30, 16 - i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 3 To 2 Step -1
Cells(30, i).Select
Selection.Interior.ColorIndex = xlNone Cells(i + 26, 1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 30 To 4 Step -1
Cells(i, 1).Select
Selection.Interior.ColorIndex = xlNone Cells(i - 3, 1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
For i = 3 To 2 Step -1
Cells(i, 1).Select
Selection.Interior.ColorIndex = xlNone Cells(1, 5 - i).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Next
Next。