'excel文件和工作簿
'excel文件就是excel工作簿，excel文件打开需要excel程的支持
'Workbooks 工作簿集合，泛指excel文件或工作簿
'1. 令文件A的第1个sheet中单元格A1等于100
Sub t1()
Workbooks("A.xls").Sheets(1).Range("a1") = 100 'Workbooks("A.xls")，名称为A的excel工作簿
End Sub
'1. 令第二个工作簿的第2个sheet中单元格A1等于200
Sub t2()
Workbooks(2).Sheets(2).Range("a1") = 200 'workbooks(2)，按打开顺序，第二个打开的工作簿
End Sub
'ActiveWorkbook ：当打开多个excel工作簿时，你正在操作的那个就是ActiveWorkbook（活动工作簿）
'Thisworkbook：VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿
'工作簿窗口
'Windows("A.xls"),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。
'1. 隐藏工作簿A
Sub t3()
Windows("A.xls").Visible = False
End Sub
'2. 取消隐藏第二个sheet
Sub t4()
Sheets(2).Visible = True
End Sub
'3. 判断A.Xls文件是否存在
Sub W1()
If Len(Dir("d:/A.xls")) = 0 Then
MsgBox "A文件不存在"
Else
MsgBox "A文件存在"
End If
End Sub
'4. 判断A.Xls文件是否打开
Sub W2()
Dim X As Integer
For X = 1 To Windows.Count
If Windows(X).Caption = "A.XLS" Then
MsgBox "A文件打开了"
Exit Sub
End If
Next
End Sub
'5. excel文件新建和保存
Sub W3()
Dim wb As Workbook
Set wb = Workbooks.Add
wb.Sheets("sheet1").Range("a1") = "abcd"
wb.SaveAs "D:/B.xls"
End Sub
'6. excel文件打开和关闭
Sub w4()
Dim wb As Workbook
Set wb = Workbooks.Open("D:/B.xls")
MsgBox wb.Sheets("sheet1").Range("a1").Value
wb.Close False '关闭工作簿且不保存
End Sub
'7. excel文件保存和备份
Sub w5()
Dim wb As Workbook
Set wb = ThisWorkbook
wb.Save
wb.SaveCopyAs "D:/ABC.xls"
End Sub
'8. excel工作表的移动
Sub s4()
Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面
Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面
End Sub
'9. excel文件复制
Sub s5() '在本工作簿中
Dim sh As Worksheet
Sheets("模板").Copy before:=Sheets(1)
Set sh = ActiveSheet
sh.Name = "1日"
sh.Range("a1") = "测试"
End Sub
Sub s6() '另存为新工作簿
Dim wb As Workbook
Sheets("模板").Copy
Set wb = ActiveWorkbook
wb.SaveAs ThisWorkbook.Path & "/1日.xls"
wb.Sheets(1).Range("b1") = "测试"
wb.Close True '关闭且保存
End Sub
'10. 工作表删除
Sub s9()
Application.DisplayAlerts = False '不显示删除时提示的提示框
Sheets("模板").Delete
Application.DisplayAlerts = True
End Sub
'11. 工作表的选取
Sub s10()
Sheets("sheet2").Select
End Sub
'12. 保护工作表
Sub s7()
Sheets("sheet2").Protect "123"
End Sub
Sub s8() '判断工作表是否添加了保护密码
If Sheets("sheet2").ProtectContents = True Then
MsgBox "工作簿保护了"
Else
MsgBox "工作簿没有添加保护"
End If
End Sub
'单元格选取
'1. 表示一个单元格(a1)
Sub s()
'Range("a1").Select '方法1
'Cells(1, 1).Select '方法2
'Range("A" & 1).Select '方法3
'Cells(1, "A").Select '方法4
'Cells(1).Select '方法5
[a1].Select '方法6
End Sub
'2. 表示相邻单元格区域
Sub d() '选取单元格a1:c5
'Range("a1:c5").Select
'Range("A1", "C5").Select
'Range(Cells(1, 1), Cells(5, 3)).Select
'Range("a1:a10").Offset(0, 1).Select
Range("a1").Resize(5, 3).Select '以A1为起点的总行数和总列数
End Sub
'3. 表示不相邻的单元格区域
Sub d1()
Range("a1,c1:f4,a7").Select
'Union(Range("a1"), Range("c1:f4"), Range("a7")).Select '选取多个单元格
End Sub
Sub dd() 'union示例
Dim rg As Range, x As Integer
For x = 2 To 10 Step 2
If x = 2 Then Set rg = Cells(x, 1)
Set rg = Union(rg, Cells(x, 1))
Next x
rg.Select
End Sub
'4. 表示行
Sub h()
'Rows(1).Select
'Rows("3:7").Select '第3到7行
'Range("1:2,4:5").Select '第1到2行和4到5行，即选取不连续的行
Range("c4:f5").EntireRow.Select '选取单元格C4:F5所在的行
End Sub
'5. 表示列
Sub L()
'Columns(1).Select
'Columns("A:B").Select
'Range("A:B,D:E").Select
Range("c4:f5").EntireColumn.Select '选取c4:f5所在的列
End Sub
'6. 重置坐标，新坐标系以B2为起点
Sub cc()
Range("b2").Range("a1") = 100
End Sub
'7. 将正在选取的单元格区域内容改为100
Sub d2()
Selection.Value = 100
End Sub
'特殊单元格定位
'1. 选取sheet2已使用的单元格区域
Sub d1()
Sheets("sheet2").UsedRange.Select
'wb.Sheets(1).Range("a1:a10").Copy Range("i1")
End Sub
'2. 选取B8所在的已使用的单元格区域
Sub d2()
Range("b8").CurrentRegion.Select
End Sub
'3. 两个单元格区域共同的区域
Sub d3()
Intersect(Columns("b:c"), Rows("3:5")).Select
End Sub
'4. 调用定位条件选取特殊单元格
Sub d4()
Range("A1:A6").SpecialCells(xlCellTypeBlanks).Select '选取空单元格
End Sub
'5. 端点单元格
Sub d5()
Range("a65536").End(xlUp).Offset(1, 0) = 1000 '类似于Ctrl+向上键
End Sub
Sub d6()
Range(Range("b6"), Range("b6").End(xlToRight)).Select
End Sub
'单元格信息
'1. 单元格的值
Sub x1()
Range("b10") = Range("c2").Value
Range("b11") = Range("c2").Text
Range("c10") = "'" & Range("b2").Formula 'Formula表示返回的是公式
End Sub
'2. 单元格的地址
Sub x2()
With Range("b2").CurrentRegion
[b12] = .Address '绝对地址
[c12] = .Address(0, 0) '相对地址
[d12] = .Address(1, 0) '列相对，行绝对
[e12] = .Address(0, 1) '行相对，列绝对
[f12] = .Address(1, 1) '绝对地址，两个1可省略
End With
End Sub
'3. 单元格的行列信息
Sub x3()
With Range("b2").CurrentRegion
[b13] = .Row
[b14] = .Rows.Count '单元格区域的总行数
[b15] = .Column
[b16] = .Columns.Count
[b17] = .Range("a1").Address
End With
End Sub
'4. 单元格的格式信息
Sub x4()
With Range("b2")
[b19] = .Font.Size
[b20] = .Font.ColorIndex
[b21] = .Interior.ColorIndex
[b22] = .Borders.LineStyle
End With
End Sub
'5. 单元格批注信息
Sub x5()
[B24] = Range("I2").Comment.Text
End Sub
'6. 单元格的位置信息
Sub x6()
With Range("b2")
[b26] = .Top
[b27] = .Left
[b28] = .Height
[b29] = .Width
End With
End Sub
'7. 单元格的上级信息
Sub x7()
With Range("b2")
[b31] = .Parent.Name '所在工作表名称
[b32] = .Parent.Parent.Name '所在工作表的所在工作簿名称
End With
End Sub
'8. 内容判断
Sub x8()
With Range("b2")
[b34] = .HasFormula '是否有公式
[b35] = .Hyperlinks.Count '超链接个数
End With
End Sub
'单元格格式
'1. Excel中的颜色可以用两种方式获取，一种是EXCEL内置颜色，另一种是利用QBCOLOR函数返回
Sub y1()
Dim x As Integer
Range("a1:b60").Clear
For x = 1 To 56
Range("a" & x) = x
Range("b" & x).Font.ColorIndex = 3
Next x
End Sub
Sub y2()
Dim x As Integer
For x = 0 To 15
Range("d" & x + 1) = x
Range("e" & x + 1).Interior.Color = QBColor(x)
Next x
End Sub
Sub y3()
Dim 红 As Integer, 绿 As Integer, 蓝 As Integer
红 = 255
绿 = 123
蓝 = 100
Range("g1").Interior.Color = RGB(红, 绿, 蓝)
End Sub
'2. 判断数值的格式
'2.1 判断是否为空单元格
Sub d1()
[b1] = ""
'If Range("a1") = "" Then
'If Len([a1]) = 0 Then
If VBA.IsEmpty([a1]) Then
[b1] = "空值"
End If
End Sub
'2.2 判断是否为数字
Sub d2()
[b2] = ""
'If VBA.IsNumeric([a2]) And [a2] <> "" Then
If Application.WorksheetFunction.IsNumber([a2]) Then
[b2] = "数字"
End If
End Sub
'2.3 判断是否为文本
Sub d3()
[b3] = ""
'If Application.WorksheetFunction.IsText([A3]) Then
If VBA.TypeName([a3].Value) = "String" Then
[b3] = "文本"
End If
End Sub
'2.4 判断是否为汉字
Sub d4()
[b4] = ""
If [a4] > "z" Then
[b4] = "汉字"
End If
End Sub
'2.5 判断错误值
Sub d10()
[b5] = ""
'If VBA.IsError([a5]) Then
If Application.WorksheetFunction.IsError([a5]) Then
[b5] = "错误值"
End If
End Sub
Sub d11()
[b6] = ""
If VBA.IsDate([a6]) Then
[b6] = "日期"
End If
End Sub
'3. 设置单元格自定义格式
Sub d30()
Range("d1:d8").NumberFormatLocal = "0.00"
End Sub
'4. 按指定格式从单元格返回数值
'Format函数语法(和工作表数Text用法基本一致)
'Format(数值,自定义格式代码)
'5. 单元格合并
Sub h1()
Range("g1:h3").Merge
End Sub
'5.1. 合并区域的返回信息
Sub h2()
Range("e1") = Range("b3").MergeArea.Address '返回单元格所在的合并单元格区域
End Sub
'5.2. 判断是否含合并单元格
Sub h3()
'MsgBox Range("b2").MergeCells
' MsgBox Range("A1:D7").MergeCells
Range("e2") = IsNull(Range("a1:d7").MergeCells)
Range("e3") = IsNull(Range("a9:d72").MergeCells)
End Sub
'5.3. 综合示例
'合并H列相同单元格
Sub h4()
Dim x As Integer
Dim rg As Range
Set rg = Range("h1")
Application.DisplayAlerts = False
For x = 1 To 13
If Range("h" & x + 1) = Range("h" & x) Then
Set rg = Union(rg, Range("h" & x + 1))
Else
rg.Merge
Set rg = Range("h" & x + 1)
End If
Next x
Application.DisplayAlerts = True
End 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").Copy
ActiveSheet.Paste Range("d1") '粘贴至D1
End Sub
Sub t4()
Range("a1:a10").Copy
Range("e1").PasteSpecial (xlPasteValues) '只粘贴为数值
End Sub
Sub t5()
Range("a1:a10").Cut
ActiveSheet.Paste Range("f1") '粘贴到f1
End Sub
Sub t6()
Range("c1:c10").Copy
Range("a1:a10").PasteSpecial Operation:=xlAdd '选择粘贴-加
End Sub
Sub T7()
Range("G1:G10") = Range("A1:A10").Value
End Sub
'3. 填充公式
Sub T8()
Range("b1") = "=a1*10"
Range("b1:b10").FillDown '向下填充公式
End Sub
'4.插入行
Sub c1()
Rows(4).Insert '插入行，原单元格下移
End Sub
Sub c2() '插入行并复制公式
Rows(4).Insert
Range("3:4").FillDown
Range("4:4").SpecialCells(xlCellTypeConstants) = ""
End Sub
Sub c3() '不同值之间插入空行
Dim x As Integer
For x = 2 To 20
If Cells(x, 3) <> Cells(x + 1, 3) Then
Rows(x + 1).Insert
x = x + 1
End If
Next x
End Sub
Sub c4() '分类汇总
Dim x As Integer, m1 As Integer, m2 As Integer
Dim k As Integer
m1 = 2
For 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 If
Next x
End Sub
Sub c44() '个人方法
Dim x As Integer
Dim t As Integer
t = Range("c65536").End(xlUp).Row
For x = t To 2 Step -1
If Cells(x, 3) <> Cells(x - 1, 3) Then
Rows(x).Insert
Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row + 1, "C") = Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row, "C") & " 小计"
Cells(Cells(x, "H").Offset(1, 0).End(xlDown).Row + 1, "H") = _
Application.Sum(Range(Cells(x, "h").Offset(1, 0), Cells(x, "H").Offset(1, 0).End(xlDown)))
End If
Next x
End Sub
Sub dd() '批量删除空行
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
