目录
CH6 单元格操作
CH7 EXCEL事件
CH8 VBA数组
CH9 VBA字典
<br />
<br />
CH6 单元格操作
一、单元格的选取
1 表示一个单元格(a1)
Sub s()
Range("a1").Select
Cells(1, 1).Select
Range("A" & 1).Select
Cells(1, "A").Select
Cells(1).Select
[a1].Select
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
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
Range("1:2,4:5").Select
Range("c4:f5").EntireRow.Select
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 重置坐标下的单元格表示方法
Sub cc()
Range("b2").Range("a1") = 100
End Sub
7 表示正在选取的单元格区域
Sub d2()
Selection.Value = 100
End Sub
二、特殊单元格定位
1 已使用的单元格区域
Sub d1()
Sheets("sheet2").UsedRange.Select
wb.Sheets(1).Range("a1:a10").Copy Range("i1")
End Sub
2 某单元格所在的单元格区域
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
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("I3").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)
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("b3")
[b26] = .Top
[b27] = .Left
[b28] = .Height
[b29] = .Width
End With
End Sub
7 单元格的上级信息
Sub x7()
With Range("b3")
[b31] = .Parent.Name
[b32] = .Parent.Parent.Name
End With
End Sub
8 内容判断
Sub x8()
With Range("i3")
[b34] = .HasFormula
[b35] = .Hyperlinks.Count
End With
End Sub
四、单元格的数字格式
1.判断数值的格式
(1) 判断是否为空单元格
Sub d1()
[b1] = ""
If Range("a1") = "" Then
If Len([a1]) = 0 Then
If VBA.IsEmpty([a1]) Then
[b1] = "空值"
End If
End Sub
(2) 判断是否为数字
Sub d2()
[b2] = ""
If VBA.IsNumeric([a2]) And [a2] <> "" Then
If Application.WorksheetFunction.IsNumber([a2]) Then
[b2] = "数字"
End If
End Sub
(3) 判断是否为文本
Sub d3()
[b3] = ""
If Application.WorksheetFunction.IsText([A3]) Then
If VBA.TypeName([a3].Value) = "String" Then
[b3] = "文本"
End If
End Sub
(4) 判断是否为汉字
Sub d4()
[b4] = ""
If [a4] > "z" Then
[b4] = "汉字"
End If
End Sub
(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
2.设置单元格自定义格式
Sub d30()
Range("d1:d8").NumberFormatLocal = "0.00"
End Sub
3.按指定格式从单元格返回数值
Format函数语法(和工作表数Text用法基本一致)
Format(数值,自定义格式代码)
五、设置Excel中的颜色
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
六、单元格合并
1.单元格合并
Sub h1()
Range("g1:h3").Merge
End Sub
2.合并区域的返回信息
Sub h2()
Range("e1") = Range("b3").MergeArea.Address ' 返回单元格所在的合并单元格区域
End Sub
3.判断是否含合并单元格
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
4.综合示例
合并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.插入行并复制公式
(1)插入行
Sub c1()
Rows(4).Insert
End Sub
(2)插入行并复制公式
Sub c2() '插入行并复制公式
Rows(4).Insert
Range("3:4").FillDown
Range("4:4").SpecialCells(xlCellTypeConstants) = ""
End Sub
(3)如不相同,则插入一行
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
(4)相同部门插入小计汇总
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
(5)删除小计行
Sub dd() 删除小计行
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
八、单元格查询
1 使用循环查找 (在单元格中查找效率太低)
2 调用工作表函数
Sub c1() 判断是否存在,并查找所在行数
Dim hao As Integer
Dim icount As Integer
icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
If icount > 0 Then
MsgBox "该入库单号码已经存在,请不要重复录入"
MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0)
End If
End Sub
3 使用Find方法
Sub c2()
Dim r As Integer, r1 As Integer
Dim icount As Integer
icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
If icount > 0 Then
r = Sheets("库存明细表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row 查找号码第一次出现的位置
r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).Row
MsgBox r & ":" & r1
End If
End Sub
4 返回最下一行非空行的行数
Sub c3() 返回最下一行非空行的行数
MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).Row
End Sub
5 入库单查询实例
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 Then
MsgBox "该单据号码已经存在!,请不要重复录入"
Exit Sub
Else
r = 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).Value
MsgBox "输入已完成"
End If
End With
End Sub
Sub 查找()
Dim c As Integer '号码在库存表中的个数
Dim r As Integer '入库单的数据行数
With Sheets("库存明细表")
c = Application.CountIf(.[b:b], Range("g3"))
If c = 0 Then
MsgBox "该单据号码不存在!"
Exit Sub
Else
r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
Range("c3") = .Cells(r, 3)
Range("e3") = .Cells(r, 1)
Cells(6, 2).Resize(c, 5) =