'怎么按.弹出提示:dim a as ??后a.即可。
'如想提示comment对象的方法和属性,Dim t As Comment后输入t.即可
Sub s()
[a1] = "=b1 + 16" '=B1+16
[a2] = Evaluate("=b1 + 16") '17,显示公式计算的结果
[a3] = "=b1" & "&""me""" & "&16" '=B1&"me"&16
[a4].FormulaArray = "=sum(b1:b2*c1:c2)" '={=SUM(B1:B2*C1:C2)}
End Sub
Sub s()
For i = 1 To 11
If i = 5 Then Stop '运行到这里会进入debug模式
Next i
End Sub
Sub s() 'a1的内容是"=3-1",并把格式设成百分比
'.text 是设置了格式后显示的内容, 而.value 是单元格内实际的值
Debug.Print [a1].Text '200.00%
Debug.Print [a1].Value '2
Debug.Print [a1].Formula '=3-1
End Sub
Sub s()
Dim t As Comment
Set t = [a1].Comment
t1 = t.Text '获取注释的文本内容
t.Delete '删除注释
End Sub
Sub s()
'第一个参数是行是否绝对地址,第二是列,默认全部绝对地址
t1 = [a1].Address(0, 1) '$A1
t2 = [a1].Address(1, 0) 'A$1
t3 = [a1].Address(1, 1) '$A$1
t4 = [a1].Address(0, 0) 'A1
t5 = [a1].Address '$A$1
End Sub
Sub s() '单元格的位置信息
t1 = [b2].Top
t2 = [b2].Left
t3 = [b2].Width
t4 = [b2].Height
End Sub
't1是单元格的parent,工作表;t2是工作表的parent,工作簿
Sub s()
Set t1 = [b2].Parent
tn1 = t1.Name
Set t2 = t1.Parent
tn2 = t2.Name
End Sub
Sub s()
'如果区域中所有单元格均包含公式,则该属性值为 True;
'如果所有单元格均不包含公式,则该属性值为 False;
'其他情况下为 null。 只读 Variant 类型。
t1 = [a1].HasFormula
t2 = [a2].HasFormula
t3 = Range("a1:a2").HasFormula
'获取一个区域里Hyperlinks超链接的格式
t4 = Range("a1:c4").Hyperlinks.Count
End Sub
'type(单元格)=range,type(空单元格.value)=empty,可以用来判断单元格是否非空
Sub s()
'a1是数字,a3是字符串asd,a3是字符串123('123),a11是空单元格
'a5是=1/0(显示#DIV/0!),
t1 = IsEmpty([a1]) 'false
t2 = IsEmpty([a11]) 'true,可以用来判断单元格是否非空
'vba的函数忘记名字时,vba.可以得到提示
'IsNumeric判断是不是数字,但空单元格也返回true,所以需要 And Not IsEmpty([a11])
t3 = VBA.IsNumeric([a1]) 'true
t4 = IsNumeric([a1]) 'true
t5 = VBA.IsNumeric([a11]) 'true
t6 = VBA.IsNumeric([a11]) And Not IsEmpty([a11]) 'false
t7 = Application.WorksheetFunction.IsNumber([a1]) 'true
t8 = Application.WorksheetFunction.IsNumber([a11]) 'false
s1 = Application.WorksheetFunction.IsText([a1]) 'false
s2 = Application.WorksheetFunction.IsText([a11]) 'false
s3 = Application.WorksheetFunction.IsText([a3]) 'true
a3type = VBA.TypeName([a3].Value) 'string
a4type = TypeName([a4].Value) 'string
s5 = VBA.IsError([a5]) 'true
a5type = TypeName([a5].Value) 'error
'判断单个字符是不是小写字母,注意a<a啊<z
s6 = [a7] >= "a" And [a7] <= "z"
'isdate方法判断标准不太明白,需要用时再百度
End Sub
Sub s()
Dim rg As Range
Set rg = [a1]
For i = 2 To 4
Set rg = Union(rg, Range("a" & i))
rg.Select
Next i
rg.Merge 'union之后一起合并单元格效率更高
End Sub
Sub s()
'a2:b4
'Dim t As Range
Set t = [b3].MergeArea '[b3]所属的MergeArea,是range对象
t1 = t.Row '2,MergeArea区域第一个单元格的row
t2 = t.Column '1,MergeArea区域第一个单元格的column
t3 = t.Count '6
t4 = t.Address '"$A$2:$B$4"
End Sub
Sub s()
'合并单元格时可能弹窗提示,不让提示
Application.DisplayAlerts = False
'MergeCells似乎和HasFormula一样,区域里不包含合并单元格返回false,
'区域里全部是合并单元格返回true,否则(有合并单元格也有非合并的单元格)返回null
Range("a2:b3").MergeCells = True
t1 = Range("a1:b1").MergeCells 'false
t2 = Range("a1:b3").MergeCells 'null
t3 = Range("b2:b3").MergeCells 'true
'两种合并单元格方法
Range("b2:b5").MergeCells = True
'Range("b2:b5").Merge
'两种取消合并单元格方法,只要把mergearea里任何一个单元格取消合并,整个区域都会取消
Range("b2:b2").MergeCells = False
'Range("b2:b2").UnMerge
Application.DisplayAlerts = True
End Sub
Sub s()
'chr(13)是回车符,enter
'chr(10)是换行符,LF, Line Feed, 换行,进纸一行
[a1] = "a" & Chr(10) & "b" 'a换行b
[a2] = "a" & Chr(13) & "b" 'ab
End Sub
'选择某区域,选择性粘贴数值+转置的录制宏
Sub s()
Selection.Copy
Range("a1").PasteSpecial Paste:=xlPasteValues,operation:=xlPasteSpecialOperationNone, Transpose:=True
End Sub
'把a1:a7的值加到b1:b7上,也可以写operation:=xlAdd,还可以对被选择的区域进行粘贴
Sub s()
Range("a1:a7").Copy
Range("b1").PasteSpecial operation:=xlPasteSpecialOperationAdd
'Range("a1").PasteSpecial operation:=xlAdd
End Sub
Sub s() '一个区域里,只要某个单元格为空,则删除该行
Range("a1:b7").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
'也可以用EntireColumn删除列,还可以用ClearContents清除内容
'如果该区域没有空单元格,SpecialCells(xlCellTypeBlanks)会返回nothing,继续执行会报错,需要处理
'删除行时,如果第一列删除1和2行,第二列删除2和3行,会报错不能在重叠区域使用此命令。
'debug可以发现此时选择了4行(1,2,2,3),可以考虑遍历t进行union再删除
Sub s()
Dim t As Range
Set t = Range("a1:d7").SpecialCells(xlCellTypeBlanks) 'nothing
t.Select
Set t = t.EntireRow
'Set t = t.EntireColumn
t.Select
't.ClearContents
t.Delete
End Sub
Sub s() 'fillup和fillleft失败了,resize不能输入负数。可以考虑转换成down和right
Set rg = [c4]
[c4] = "=row()*2"
rg.Resize(9, 1).FillDown
rg.Resize(1, 9).FillRight
Set r = rg.Offset(-2, 1)
r.Select
r.Resize(3, 1).Select
rg.FillUp
End Sub
Sub s1() '多列填充公式
Set rg = [c4:e4]
rg(1) = "=row()"
rg(2) = "=row()*2"
rg(3) = "=row()*3"
rg.Resize(9, 3).FillDown
End Sub
'循环查找非空的单元格,可以发现range的第2个单元格开始找,跳过了b4,最后再找b4
'LookIn默认是xlFormulas,同时检索value和公式
'如果之前的检索设置LookIn:=xlValues,这次检索不设置(用默认的),会沿用上次检索的设置(LookIn:=xlValues)
'lookat:=xlPart, LookIn:=xlFormulas可以检索到部分公式的内容,如what:=r时可以检索到row函数
Sub s1()
Dim r As Range
Set r = Range("b4:c10")
searchword = "*"
Set x2 = r.Find(searchword, lookat:=xlPart, LookIn:=xlFormulas)
If Not x2 Is Nothing Then x3 = x2.Address
Do While True
If x2 Is Nothing Then Exit Do
x2r = x2.Row
x2c = x2.Column
MsgBox x2r & ":" & x2c
Set x2 = r.Find(searchword, after:=x2)
If x3 = x2.Address Then Exit Do
Loop
End Sub
'返回行数最大的非空单元格,searchorder:=xlColumns查找列数最大的非空单元格
Sub s1()
Set d = ActiveSheet.Cells.Find("*", searchdirection:=xlPrevious, searchorder:=xlRows)
MsgBox d.Row
End Sub
'Target = Target + 1会不停的触发Worksheet_Change,修改EnableEvents可以避免不停触发
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
MsgBox Target.Value & ":" & Target.Address
Target = Target + 1
Application.EnableEvents = True
End Sub
Sub s()
a = Array(1, 9, 7, -100, 5, 6, "A", "c", "a")
a(3) = Empty
a1 = Application.Max(a) '9
a2 = Application.Min(a) '1
a3 = Application.Large(a, 2) '7,数组第2大的值
a4 = Application.Small(a, 2) '5,数组第2小的值
a5 = Application.Sum(a) '28,数组求和
a6 = Application.Count(a) '5,数组里数字个数
a7 = Application.CountA(a) '8,数组里已填充内容的个数
a8 = Application.Match("a", a, 0) '7,在数组里查找,不排序,不区分大小写,从1开始
a9 = Application.Match("C", a, 0) '8
a0 = Application.Match("z", a, 0) 'error
End Sub
Match_type行为
Match_type=1 或省略
MATCH 查找小于或等于 lookup_value 的最大值。 lookup_array 参数中的值必须以升序排序,例如:…-2,
-1, 0, 1, 2, …, A-Z, FALSE, TRUE。
Match_type=0
MATCH 查找完全等于 lookup_value 的第一个值。 lookup_array 参数中的值可按任何顺序排列。
Match_type=-1
MATCH 查找大于或等于 lookup_value 的最小值。 lookup_array 参数中的值必须按降序排列,例如:TRUE,
FALSE, Z-A, …2, 1, 0, -1, -2, … 等等。
Sub s11()
s = "a-b-a-d"
a = VBA.Split(s, "-")
s1 = VBA.Join(a, ",")
'参数3=true时根据条件筛选出新数组,false时取反,默认true
a1 = VBA.Filter(a, "a") 'a,a
a2 = VBA.Filter(a, "a", False) 'b,d
'index可以获取二维数组的某一行/列,得到新数组
Dim b(2, 3)
For i = LBound(b) To UBound(b)
For j = LBound(b, 2) To UBound(b, 2)
b(i, j) = i * 10 + j
Next j
Next i
Cells(1, 1).Resize(UBound(b) - LBound(b) + 1, UBound(b, 2) - LBound(b, 2) + 1) = b
b1 = Application.Index(b, , 1) '第一列(索引=0的列),(1 to 3,1 to 1)
b2 = Application.Index(b, 1) '第一行(索引=0的行),(1 to 4)
c = Application.VLookup(10, b, 4, 0) '13,返回第一列是10的行的第四个值
'application.worksheetfunction.countif的参数1是range,用数组一直报错,sumif也是
End Sub
'根据条件设置格式的3种方法:
'比如第一列的某行的值满足某条件,就给该行的a,b列设置颜色
Sub s1() '方法1,根据条件拼接范围的字符串,最后设置格式。注意字符串长度不能超过255
s = "a1:b3,a6:b6"
Range(s).Interior.Color = RGB(222, 222, 222)
End Sub
Sub s2() '方法2,字符串只拼接行数,取交集设置格式
s = "1:3,6:6" '注意这里不能写1:3,6
Application.Intersect(Range("a:b"), Range(s)).Interior.Color = RGB(222, 222, 222)
End Sub
'方法3,如果只对数据所在的单元格设置格式,可以用条件格式设置。具体代码可录制宏
Function a(ParamArray n()) '用ParamArray设置不定参数,对sub也适用
For Each i In n
MsgBox i
Next i
aa = n
End Function
Sub b()
Call a(2, [a1], "g", True)
End Sub
'worksheetfunction的choose方法:参数1是索引,之后的不定参数是选取范围,返回此范围里第索引(从1开始)个值
'参数是小数时,向下取整。所以代码返回A1:B1,再求和
=SUM(CHOOSE(1.8,A1:B1,A2:B2,A3:B3))
Sub s11()
Dim x() As Byte
x = StrConv("ABcd", vbFromUnicode) '65,66,99,100
y = Asc("A") '65
a = Chr(65) 'A
b = String(4, "a") 'aaaa
s = " a b "
s1 = Trim(s) '"a b"
s2 = LTrim(s) '"a b "
s3 = RTrim(s) '" a b"
v = Val("1+2a") '返回1,val可以提取字符串前面的数字
End Sub
Sub s11()
Dim r As Range
Set r = Application.InputBox("", Type:=8) '必须+application
MsgBox r.Parent.Name & ":" & r.Address 'Sheet1:$A$1:$B$2
x1 = Application.InputBox("", Type:=1) '只能输入数字
x2 = Application.InputBox("", Type:=2) '文本,输入数字被转成文本数字
x4 = Application.InputBox("", Type:=4) '布尔值,输入文本会被转成布尔值
x64 = Application.InputBox("", Type:=64) '数组,如输入{"a",3}
End Sub
通常,用户自定义函数后,在“粘贴函数”对话框中将会出现在“用户定义”类别中。如果希望自定义函数出现在其它的类别中,必须编写和执行VBA代码为自定
义函数指定类别。如运行Application.MacroOptions
Macro:=”SumPro”,Category:=4语句后,将自定义的SumPro函数指定给“统计函数”类别。
Sub 类型判断()
'判断是不是数字,空单元格返回false
t1 = Application.WorksheetFunction.IsNumber([a33])
Dim arr(), ar
t2 = VBA.IsArray(arr) 'true
t3 = VBA.IsArray(ar) 'false
'是不是单个字母,也可以用Asc("A")判断
t4 = "A" Like "[A-Za-z]" 'true
t5 = "[A-Za-z]" Like "A" 'false,注意顺序
End Sub
Sub uu()
d1 = Date '#2020/9/25#
d2 = Time '#11:27:00#
d = Now() '#2020/9/25 11:27:00#
a1 = Format(d, "mmmm-dddd-yyyy") 'September-Friday-2020
a2 = VBA.DateSerial(2020, 11, 22) '#2020/11/22#
a3 = VBA.TimeSerial(11, 12, 13) '#11:12:13#
a4 = Year(d)
a5 = Month(d)
a6 = Day(d)
a7 = Hour(d)
a8 = Minute(d)
a9 = Second(d)
End Sub
Sub uu()
d1 = #11/11/2020# '注意不要双引号
d2 = #12/22/2022#
a1 = DateDiff("m", d1, d2) '12*2+1=25
d3 = DateAdd("m", -25, d2) '#2020/11/22#
d4 = d1 - d2 '-771,11+30+365*2=771,2020多出的1天在2月,不用加进去
End Sub
Sub uu() '当前时间+11秒,方法3可以输入负数
d1 = Now + #12:00:11 AM#
d2 = Now + TimeValue("00:00:11")
d3 = DateAdd("s", 11, Now)
End Sub
'插入图片,录制宏后稍加修改
Sub Macro1() '直接插入图片
Range("B2").Select
ActiveSheet.Shapes.AddPicture Filename:="D:\壁纸\pic\Konachan.com - 266929 sample.jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-1, Top:=-1, Width:=-1, Height:=-1
End Sub
'先插入矩形,把图片设为矩形的背景图片,这样可以控制图片的大小(直接设置图片大小由于图片的比例问题失败)
'矩形的边框不知道怎么去除,这里用s.Line.Visible = msoFalse设为不可见
'OnAction 可以设置点击图片调用的方法
Sub a()
Dim s As Shape
Set s = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=61.200001, Top:=34.200001, Width:=297, Height:=139.199997)
's.Select
s.Line.Visible = msoFalse
s.OnAction = "'1.xls'!asd"
s.Fill.Transparency = 0
With s.Fill
.UserPicture PictureFile:="D:\壁纸\pic\Konachan.com - 266929 sample.jpg"
.Transparency = 0
End With
End Sub
Sub uu()
Dim s As Shape
For Each s In Sheets(1).Shapes
a1 = s.TopLeftCell.Address
a2 = s.BottomRightCell.Address
a3 = s.Visible
a4 = s.OnAction
s.Visible = True
s.Left = [b3].Left '移动图片,使左上角与[b3]单元格左上角对齐
s.Top = [b3].Top
t=s.type '不同类型的图形type不同,详情百度
Next s
End Sub
Sub b() '批量删除和创建多选框
Set sh = ActiveSheet
For Each s In sh.CheckBoxes
s.Delete
Next s
For Each rg In Range("a1:a5")
Set c = sh.CheckBoxes.Add(rg.Left, rg.Top, rg.Width, rg.Height)
c.Text = rg.Address(0, 0) 'A1,A2,...,A5
Next
End Sub
Sub b() '批量隐藏/显示sheet
Dim a(2)
a(0) = 1
a(1) = 2
Sheets(a).Visible = True
End Sub
'类模块rr
Option Explicit
Dim a, b
Property Let aa(a1)
a = a1
End Property
Property Let bb(b1)
b = b1
End Property
Property Get ss()
ss = a * b
End Property
Property Set red(rg As Range)
rg.Interior.Color = RGB(255, 0, 0)
End Property
'普通模块
Sub u()
Dim p As New pp
p.aa = 3
p.bb = 2
x = p.ss '6
Set p.red = [a1] 'a1变红
End Sub