VBA学习笔记2-文件打开、保存、备份、关闭等；工作表选取、删除、移动等；单元格定位、格式、合并等
2018-01-11 11:44
801 查看
'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
F
cafc
or 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
'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
F
cafc
or 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
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- Python学习笔记(20)-文件和文件夹的移动、复制、删除、重命名
- C#学习笔记（十六）：使用打开保存文件对话框
- C#学习笔记（十六）：使用打开保存文件对话框
- PyQt5学习笔记09----标准文件打开保存框QFileDialog
- 工作笔记——限定input上传文件对话框中能选取的文件的格式
- linux 学习笔记（三）：open、creat、close 函数的使用，文件的创建、打开与关闭
- [Vim]vim学习笔记--多个文件打开，切换，关闭
- linux下文件的复制、移动、删除命令参数详解（学习笔记）
- sql server 关于表中只增标识问题 C# 实现自动化打开和关闭可执行文件（或 关闭停止与系统交互的可执行文件） ajaxfileupload插件上传图片功能，用MVC和aspx做后台各写了一个案例 将小写阿拉伯数字转换成大写的汉字， C# WinForm 中英文实现， 国际化实现的简单方法 ASP.NET Core 2 学习笔记（六）ASP.NET Core 2 学习笔记（三）
- C#学习笔记（十六）：使用打开保存文件对话框
- C#学习笔记（十六）：使用打开保存文件对话框
- [Vim]vim学习笔记--多个文件打开，切换，关闭
- 安卓学习笔记---如何保存数据到SharePreference里面，获取所有sp文件以及删除文件
- php学习笔记3--文件系统的操作（创建、打开及批量删除）
- Excel开发学习笔记：文件选择控件、查找匹配项、单元格格式及数据有效性
- CodeSmith学习笔记(一)：设置属性为打开文件，保存文件
- 雅阁学习笔记之windows编程——保存文件和打开浏览文件夹窗口
- 终于解决了：在vba中，使用api打开文件保存对话框
- LaTeX 学习笔记 1 文件格式
- extjs学习笔记（六) grid中数据的保存，添加和删除