VBA 基础知识整理(单元格 表 工作簿)

'1、工作簿

Workbooks 代表工作簿集合，所有的工作簿,Workbooks(N)，表示已打开的第N个工作簿Workbooks ("工作簿名称")ActiveWorkbook 正在操作的工作簿ThisWorkBook '代码所在的工作簿

'2、工作表

' 'Sheets("工作表名称")'Sheet2.UsedRange 工作表已使用单元格集合'Sheet1 表示第一个插入的工作表,Sheet2表示第二个插入的工作表....'Sheets(n) 表示按排列顺序，第n个工作表'Sheets(1).Name = "工作表改名了"'ActiveSheet 表示活动工作表，光标所在工作表'worksheet 也表示工作表，但不包括图表工作表、宏工作表等。'Sheet1.Move before:=Sheets("Sheet3") 工作表移动到“”之前'Sheet1.Move after:=Sheets(worksheets.count) 工作表移动到所有表最后

'3、单元格

'cells 所有单元格'Range("A1").CurrentRegion 单元格所在区域连续的单元格集合'Range ("单元格地址")'Cells(行数,列数)'Activecell 正在选中或编辑的单元格'Selection 正被选中或选取的单元格或单元格区域' Range("A2").Interior.ColorIndex = 3 单元格背景色3-8

'1、用VBA在单元格中输入普通公式

Sub t1()Range("d2") = "=b2*c2"End Sub

'2、用VBA在单元格输入带引号的公式

Sub t3()Range("c16") = "=SUMIF(A2:A6,""b"",B2:B6)" '遇到单引号就把单引号加倍End Sub

'3、用VBA在单元格中输入数组公式

Sub t4()Range("c9").FormulaArray = "=SUM(B2:B6*C2:C6)"End Sub

二、利用单元格公式返回值

Sub t5()Range("d16") = Evaluate("=SUMIF(A2:A6,""b"",B2:B6)")Range("d9") = Evaluate("=SUM(B2:B6*C2:C6)")End Sub

三、借用工作表函数

Sub t6()Range("d8") = Application.WorksheeFunction.CountIf(Range("A1:A10"), "B")End Sub

'立即窗口可以把运行过程中的值立即显示出来，主要用于程序的调试

Sub d()Dim x As Integer, st As StringFor x = 1 To 10st = st & Cells(x, 1)Debug.Print "第" & x & "次运行结果:" _& stDebug.Print xNext xEnd Sub

'一、END语句

'作用：强制退出所有正在运行的程序。

'二、Exit语句

'退出指定的语句1、Exit Sub2、Exit function3、Exit for4、Exit do

on error resume next '遇到错误,跳过继续执行下一句

on error goto 0 '取消错误跳转

'on error goto '出错时跳到指定的行数

Sub t4()On Error GoTo 100Dim x As IntegerFor x = 1 To 10Cells(x, 3) = Cells(x, 2) * Cells(x, 1)Next xExit Sub100:MsgBox "在第" & x & "行出错了"End Sub

'excel文件和工作簿

'excel文件就是excel工作簿，excel文件打开需要excel程的支持

'Workbooks 工作簿集合，泛指excel文件或工作簿

'Workbooks(“A.xls”)，名称为A的excel工作簿

'ActiveWorkbook ，当打开多个excel工作簿时，正在操作的那个就是 ActiveWorkbook（活动工作簿）

'Thisworkbook，VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿。

'Windows(“A.xls”),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。

Sub t3()Windows("e:/A.xls").Visible = FalseEnd SubActiveWindow.VisibleRange.Top 活动窗体的可见单元格区域的top位置

工作表操作

'1 判断A工作表文件是否存在

Sub s1()Dim X As IntegerFor X = 1 To Sheets.CountIf Sheets(X).Name = "A" ThenMsgBox "A工作表存在"Exit SubEnd IfNextMsgBox "A工作表不存在"End Sub

'2 excel工作表的插入

Sub s2()Dim sh As WorksheetSet sh = Sheets.Addsh.Name = "模板"sh.Range("a1") = 100End Sub

'3 excel工作表隐藏和取消隐藏

Sub s3()Sheets(2).Visible = TrueEnd Sub

'4 excel工作表的移动

Sub s4()Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面End Sub

'6 excel工作表的复制

Sub s5() '在本工作簿中Dim sh As WorksheetSheets("模板").Copy before:=Sheets(1)Set sh = ActiveSheetsh.Name = "1日"sh.Range("a1") = "测试"End Sub`在这里插入代码片`

Sub s6() '另存为新工作簿

Sub s6() '另存为新工作簿Dim wb As WorkbookSheets("模板").CopySet wb = ActiveWorkbookwb.SaveAs ThisWorkbook.Path & "/1日.xls"wb.Sheets(1).Range("b1") = "测试"wb.Close TrueEnd Sub

'7 保护工作表

Sub s7()Sheets("sheet2").Protect "123"End SubSub s8() '判断工作表是否添加了保护密码If Sheets("sheet2").ProtectContents = True ThenMsgBox "工作簿保护了"ElseMsgBox "工作簿没有添加保护"End IfEnd Sub

'8 工作表删除

Sub s9()Application.DisplayAlerts = FalseSheets("模板").DeleteApplication.DisplayAlerts = TrueEnd Sub

'9 工作表的选取

Sub s10()Sheets("sheet2").SelectEnd Sub

单元格操作

'1 表示一个单元格(a1)

Sub s()Range("a1").SelectCells(1, 1).SelectRange("A" & 1).SelectCells(1, "A").SelectCells(1).Select[a1].SelectEnd Sub

'2 表示相邻单元格区域

Sub d() '选取单元格a1:c5Range("a1:c5").SelectRange("A1", "C5").SelectRange(Cells(1, 1), Cells(5, 3)).SelectRange("a1:a10").Offset(0, 1).SelectRange("a1").Resize(5, 3).SelectEnd Sub

'3 表示不相邻的单元格区域

Sub d1()Range("a1,c1:f4,a7").ActivateUnion(Range("a1"), Range("c1:f4"), Range("a7")).ActivateEnd SubSub dd() 'union示例Dim rg As Range, x As IntegerFor x = 2 To 10 Step 2If x = 2 ThenSet rg = Cells(x, 1) 'rg初始化，不然rg=nothingElseSet rg = Union(rg, Cells(x, 1))End IfNext xrg.SelectEnd Sub

'4 表示行

Sub h()Rows(1).SelectRows("3:7").SelectRange("1:2,4:5").SelectRange("c4:f5").EntireRow.SelectRange("A1").EntireRow.SelectEnd Sub

'5 表示列

Sub L()Dim first As Range, second As RangeColumns(1).SelectColumns("A:B").SelectRange("A:B,D:E").SelectSet first = Range("c4:f5").EntireRow '选取c4:f5所在的行Set second = Range("A1").EntireColumn '选取A1所在的列Union(first, second).SelectEnd Sub

'6 重置坐标下的单元格表示方法

Sub cc()Range("b2").Range("a1") = 100cells.Cells(1,1)End Sub

特殊单元格定位

'1 已使用的单元格区域

Sub d1()Sheets("sheet2").UsedRange.Selectwb.Sheets(1).Range("a1:a10").Copy Range("i1")End Sub

'2 某单元格所在的单元格区域

Sub d2()Range("b8").CurrentRegion.SelectEnd Sub

'3 两个单元格区域共同的区域

Sub d3()Intersect(Columns("b:c"), Rows("3:5")).SelectEnd Sub

'4 调用定位条件选取特殊单元格

Sub d4()Range("A1:A6").SpecialCells(xlCellTypeBlanks).SelectRange("B1:B6").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 4End Sub

'5 端点单元格

Sub d5()Range("a65536").End(xlUp).Offset(1, 0) = 1000Range("A1").End(xlToRight).End(xlDown).SelectEnd Sub

单元格信息

'1 单元格的值

Sub x1()Range("b10") = Range("c2").ValueRange("b11") = Range("c2").TextRange("c10") = "'" & Range("I3").FormulaEnd Sub

'2 单元格的地址

Sub x2()With Range("b2").CurrentRegion[b12] = .Address[c12] = .Address(0, 0)End WithEnd Sub

'3 单元格的行列信息

Sub x3()With Range("b2").CurrentRegion[b13] = .Row[b14] = .Rows.Count[b15] = .Column[b16] = .Columns.Count[b17] = .Range("a1").AddressEnd WithEnd Sub

'4、单元格的格式信息

Sub x4()With Range("b2")[b19] = .Font.Size[b20] = .Font.ColorIndex[b21] = .Interior.ColorIndex[b22] = .Borders.LineStyleEnd WithEnd Sub

'5、单元格批注信息

Sub x5()[B24] = Range("I2").Comment.TextEnd Sub

'6 单元格的位置信息

Sub x6()With Range("b3")[b26] = .Top[b27] = .Left[b28] = .Height[b29] = .WidthEnd WithEnd Sub

'7 单元格的上级信息

Sub x7()With Range("b3")[b31] = .Parent.Name[b32] = .Parent.Parent.NameEnd WithEnd Sub

'8 内容判断

Sub x8()With Range("i3")[b34] = .HasFormula[b35] = .Hyperlinks.CountEnd WithEnd Sub

单元格格式

'1 判断是否为空单元格

Sub d1()[b1] = ""If Range("a1") = "" ThenIf Len([a1]) = 0 ThenIf VBA.IsEmpty([a1]) Then[b1] = "空值"End IfEnd Sub

'2 判断是否为数字

Sub d2()[b2] = ""If VBA.IsNumeric([a2]) And [a2] <> "" ThenIf Application.WorksheetFunction.IsNumber([a2]) Then[b2] = "数字"End IfEnd Sub

'3 判断是否为文本

Sub d3()[b3] = ""If Application.WorksheetFunction.IsText([A3]) ThenIf VBA.TypeName([a3].Value) = "String" Then[b3] = "文本"End IfEnd Sub

'4 判断是否为汉字

Sub d4()[b4] = ""If [a4] > "z" Then[b4] = "汉字"End IfEnd Sub

'5 判断错误值

Sub d10()[b5] = ""If VBA.IsError([a5]) ThenIf Application.WorksheetFunction.IsError([a5]) Then[b5] = "错误值"End IfEnd SubSub d11()[b6] = ""If VBA.IsDate([a6]) Then[b6] = "日期"End IfEnd Sub

'二、设置单元格自定义格式

Sub d30()Range("d1:d8").NumberFormatLocal = "0.00"End Sub

'三、按指定格式从单元格返回数值

Format函数语法(和工作表数Text用法基本一致)Format(数值,自定义格式代码)

合并单元格

'单元格合并

Sub h1()Range("g1:h3").Mergerange.UnMerge End Sub

'合并区域的返回信息

Sub h2()Range("e1") = Range("b3").MergeArea.Address '返回合并单元格地址End Sub

'判断是否含合并单元格 MergeCells

Sub h3()MsgBox Range("b2").MergeCells ’在合并单元格中，返回trueMsgBox Range("A1:D7").MergeCells ' 不在合并单元格中，返回falseRange("e2") = IsNull(Range("a1:d7").MergeCells) '部分合并单元格，返回nullRange("e3") = IsNull(Range("a9:d72").MergeCells)End Sub

'综合示例

'合并H列相同单元格

Sub h4()Dim x As IntegerDim rg As RangeSet rg = Range("h1") '初始化Application.DisplayAlerts = FalseFor x = 1 To 13If Range("h" & x + 1) = Range("h" & x) ThenSet rg = Union(rg, Range("h" & x + 1))Elserg.MergeSet rg = Range("h" & x + 1)End IfNext xApplication.DisplayAlerts = TrueEnd Sub

单元格编辑

'1 单元格输入

Sub t1()Range("a1") = "a" & "b"Range("b1") = "a" & Chr(10) & "b" '换行答输入End Sub

'2 单元格复制和剪切

Sub t2()Range("a1:a10").Copy Range("c1") 'A1：A10的内容复制到C1起点End Sub-------------------------------------------------------------Sub t3()Range("a1:a10").CopyActiveSheet.Paste Range("d1") '粘贴至D1End Sub-----------------------------------------------------------Sub t4()Range("a1:a10").CopyRange("e1").PasteSpecial (xlPasteValues) '只粘贴为数值End Sub----------------------------------------------------------Sub t5()Range("a1:a10").CutActiveSheet.Paste Range("f1") '粘贴到f1End Sub-------------------------------------------------------------Sub t6()Range("c1:c10").CopyRange("a1:a10").PasteSpecial Operation:=xlAdd '选择粘贴-加End Sub------------------------------------------------------------Sub T7()Range("G1:G10") = Range("A1:A10").ValueEnd Sub

'3 填充公式

Sub T8()Range("b1") = "=a1*10"Range("b1:b10").FillDown '向下填充公式End Sub

单元格行列的删除和插入

Sub c1()Rows(4).InsertEnd Sub-----------------------------------------------------------------Sub c2() '插入行并复制公式Rows(4).InsertRows("12:14").InsertRange("3:4").FillDownRange("4:4").SpecialCells(xlCellTypeConstants) = ""End Sub-----------------------------------------------------------------Sub c3()Dim x As IntegerFor x = 2 To 20If Cells(x, 3) <> Cells(x + 1, 3) ThenRows(x + 1).Insertx = x + 1End IfNext xEnd Sub-----------------------------------------------------------------Sub c4()Dim x As Integer, m1 As Integer, m2 As IntegerDim k As Integerm1 = 2For x = 2 To 1000 '在范围内If Cells(x, 1) = "" Then Exit Sub ‘单元格为空，过程结束If Cells(x, 3) <> Cells(x + 1, 3) Then ’如果当前单元格不等于下个单元格m2 = x ‘记录下当前单元格行数Rows(x + 1).Insert ‘在下一单元格前面插入一行Cells(x + 1, "c") = Cells(x, "c") & " 小计" ’编辑下插入一行的单元格内容Cells(x + 1, "h") = "=sum(h" & m1 & ":h" & m2 & ")" ’起始单元格到结尾单元格相加Cells(x + 1, "h").Resize(1, 4).FillRight‘插入的单元格向右填充公式Cells(x + 1, "i") = ""‘插入的一个单元格清空x = x + 1‘跨过插入单元格，再次循环m1 = m2 + 2 ‘跨过插入单元格，再次循环End IfNext xEnd Sub----------------------------------------------------------------Sub dd() '删除小计行Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.DeleteEnd Sub

单元格查询

'1 使用循环查找 (在单元格中查找效率太低)

'2 调用工作表函数

Sub c1() '判断是否存在,并查找所在行数Dim hao As IntegerDim icount As Integericount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])If icount > 0 ThenMsgBox "该入库单号码已经存在，请不要重复录入"MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0)End IfEnd Sub-----------------------------------------------------------

'3 使用Find方法

Sub c2()Dim r As Integer, r1 As IntegerDim icount As Integericount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])If icount > 0 Thenr = Sheets("库存明细表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row '查找号码第一次出现的位置r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).RowMsgBox r & ":" & r1End IfEnd Sub------------------------------------------------------Sub c3() '返回最下一行非空行的行数MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).RowEnd Sub-----------------------------------------------------

入库单实例

Sub 输入()Dim c As Integer '号码在库存表中的个数Dim r As Integer '入库单的数据行数Dim cr As Integer '库存明细表中第一个空行的行数With Sheets("库存明细表")c = Application.CountIf(.[b:b], Range("g3"))If c > 0 ThenMsgBox "该单据号码已经存在！,请不要重复录入"Exit SubElser = Application.CountIf(Range("b6:b10"), "<>")cr = .[b65536].End(xlUp).Row + 1.Cells(cr, 1).Resize(r, 1) = Range("e3").Cells(cr, 2).Resize(r, 1) = Range("g3").Cells(cr, 3).Resize(r, 1) = Range("c3").Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).ValueMsgBox "输入已完成"End IfEnd WithEnd Sub------------------------------------------------------------Sub 查找()Dim c As Integer '号码在库存表中的个数Dim r As Integer '入库单的数据行数With Sheets("库存明细表")c = Application.CountIf(.[b:b], Range("g3"))If c = 0 ThenMsgBox "该单据号码不存在！"Exit SubElser = .[b:b].Find(Range("g3"), , , , , xlNext).RowRange("c3") = .Cells(r, 3)Range("e3") = .Cells(r, 1)Cells(6, 2).Resize(c, 5) = .Cells(r, 4).Resize(c, 5).ValueMsgBox "查询已完成"End IfEnd WithEnd Sub-----------------------------------------------------------Sub 删除()Dim c As Integer '号码在库存表中的个数Dim r As Integer '入库单的数据行数With Sheets("库存明细表")c = Application.CountIf(.[b:b], Range("g3"))If c = 0 ThenMsgBox "该单据号码不存在！"Exit SubElser = .[b:b].Find(Range("g3"), , , , , xlNext).Row.Range(r & ":" & c + r - 1).DeleteMsgBox "删除已完成"End IfEnd WithEnd SubSub 修改()Call 删除Call 输入End Sub