目录
AutoFilter
Binding
Cell Comments
Cell Copy
Cell Format
Cell Number Format
Cell Value
Cell
AutoFilter
1. 确认当前工作表是否开启了自动筛选功能
Sub filter()
If ActiveSheet.AutoFilterMode Then
MsgBox "Turned on"
End If
End Sub
当工作表中有单元格使用了自动筛选功能,工作表的AutoFilterMode的值将为True,否则为False。
2. 使用Range.AutoFilter方法
Sub Test()
Worksheets(
"Sheet1").Range(
"A1").AutoFilter _
field:=
1, _
Criteria1:=
"Otis"
VisibleDropDown:=
False
End Sub 以上是一段来源于Excel帮助文档的例子,它从A1单元格开始筛选出值为Otis的单元格。Range.AutoFilter方法可以带参数也可以不带参数。当不带参数时,表示在Range对象所指定的区域内执行“筛选”菜单命令,即仅显示一个自动筛选下拉箭头,这种情况下如果再次执行Range.AutoFilter方法则可以取消自动筛选;当带参数时,可根据给定的参数在Range对象所指定的区域内进行数据筛选,只显示符合筛选条件的数据。参数Field为筛选基准字段的整型偏移量,Criterial1、Operator和Criterial2三个参数一起组成了筛选条件,最后一个参数VisibleDropDown用来指定是否显示自动筛选下拉箭头。
其中Field参数可能不太好理解,这里给一下说明:
用上面的代码结合这个截图,如果从A1单元格开始进行数据筛选,如果Field的值为1,则表示取列表中的第一个字段即B列,以此类推,如果Field的值为2则表示C列…不过前提是所有的待筛选列表是连续的,就是说中间不能有空列。当然也可以这样,使用Range(“A1:E17”).AutoFilter,这样即使待筛选列表中有空列也可以,因为已经指定了一个待筛选区域。Field的值表示的就是将筛选条件应用到所表示的列上。下面是一些使用AutoFilter的例子。
Sub SimpleOrFilter()
Worksheets("SalesReport").Select
Range("A1").AutoFilter
Range("A1").AutoFilter Field:=4,Criteria1:="=A", Operator:=xlOr, Criteria2:="=B"
End Sub
Sub SimpleAndFilter()
Worksheets(
"SalesReport").Select
Range(
"A1").AutoFilter
Range(
"A1").AutoFilter Field:=
4, _
Criteria1:=
">=A", _
Operator:=xlAnd, Criteria2:=
"<=EZZ" End Sub Sub Top10Filter()
' Top 12 Revenue Records
Worksheets(
"SalesReport").Select
Range(
"A1").AutoFilter
Range(
"A1").AutoFilter Field:=
6, Criteria1:=
"12",Operator:=xlTop10Items
End Sub Sub MultiSelectFilter()
Worksheets("SalesReport").Select
Range("A1").AutoFilter
Range("A1").AutoFilter Field:=4, Criteria1:=Array("A", "C", "E","F", "H"),Operator:=xlFilterValues
End Sub
Sub DynamicAutoFilter()
Worksheets("SalesReport").Select
Range("A1").AutoFilter
Range("A1").AutoFilter Field:=3,Criteria1:=xlFilterNextYear,Operator:=xlFilterDynamic
End Sub
Sub FilterByIcon()
Worksheets(
"SalesReport").Select
Range(
"A1").AutoFilter
Range(
"A1").AutoFilter Field:=
6, _
Criteria1:=ActiveWorkbook.IconSets(xl5ArrowsGray).Item(
5),Operator:=xlFilterIcon
End Sub Sub FilterByFillColor()
Worksheets("SalesReport").Select
Range("A1").AutoFilter
Range("A1").AutoFilter Field:=6, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
End Sub
下面的程序是通过Excel的AutoFilter功能快速删除行的方法,供参考:
Sub DeleteRows3()
Dim lLastRow
As Long 'Last row
Dim rng
As range
Dim rngDelete
As range
'Freeze screen
Application.ScreenUpdating =
False 'Insert dummy row for dummy field name
Rows(
1).Insert
'Insert dummy field name
range(
"C1").value =
"Temp" With ActiveSheet
.UsedRange
lLastRow = .cells.SpecialCells(xlCellTypeLastCell).row
Set rng = range(
"C1", cells(lLastRow,
"C"))
rng.AutoFilter Field:=
1, Criteria1:=
"Mangoes" Set rngDelete = rng.SpecialCells(xlCellTypeVisible)
rng.AutoFilter
rngDelete.EntireRow.delete
.UsedRange
End With End Sub
返回目录
Binding
1. 一个使用早期Binging的例子
Sub EarlyBinding()
Dim objExcel
As Excel.Application
Set objExcel =
New Excel.Application
With objExcel
.Visible =
True
.Workbooks.Add
.Range(
"A1") =
"Hello World"
End With
End Sub 2. 使用CreateObject创建Excel实例
Sub LateBinding()
'Declare a generic object variable
Dim objExcel
As Object
'Point the object variable at an Excel application object
Set objExcel =
CreateObject(
"Excel.Application")
'Set properties and execute methods of the object
With objExcel
.Visible =
True
.Workbooks.Add
.Range(
"A1") =
"Hello World"
End With
End Sub 3. 使用CreateObject创建指定版本的Excel实例
Sub mate()
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application.8")
End Sub
当Create对象实例之后,就可以使用该对象的所有属性和方法了,如SaveAs方法、Open方法、Application属性等。
返回目录
Cell Comments
1. 获取单元格的备注
Private Sub CommandButton1_Click()
Dim strGotIt As String
strGotIt = WorksheetFunction.Clean(Range("A1").Comment.Text)
MsgBox strGotIt
End Sub
Range.Comment.Text用于得到单元格的备注文本,如果当前单元格没有添加备注,则会引发异常。注意代码中使用了WorksheetFunction对象,该对象是Excel的系统对象,它提供了很多系统函数,这里用到的Clean函数用于清楚指定文本中的所有关键字(特殊字符),具体信息可以查阅Excel自带的帮助文档,里面提供的函数非常多。下面是一个使用Application.WorksheetFunction.Substitute函数的例子,其中第一个Substitute将给定的字符串中的author:替换为空字符串,第二个Substitute将给定的字符串中的空格替换为空字符串。
Private Function CleanComment(author
As String, cmt
As String)
As String
Dim tmp
As String
tmp = Application.WorksheetFunction.Substitute(cmt, author &
":",
"")
tmp = Application.WorksheetFunction.Substitute(tmp,
Chr(
10),
"")
CleanComment = tmp
End Function 2. 修改Excel单元格内容时自动给单元格添加Comments信息
Private Sub Worksheet_Change(ByVal Target
As Excel.Range)
Dim newText
As String
Dim oldText
As String
For Each cell In Target
With cell
On Error Resume Next
oldText = .Comment.Text
If Err <>
0 Then .AddComment
newText = oldText &
" Changed by " & Application.UserName &
" at " &
Now & vbLf
MsgBox newText
.Comment.Text newText
.Comment.Visible =
True
.Comment.Shape.Select
Selection.AutoSize =
True
.Comment.Visible =
False
End With
Next cell
End Sub Comments内容可以根据需要自己修改,Worksheet_Change方法在Worksheet单元格内容被修改时执行。
3. 改变Comment标签的显示状态
Sub ToggleComments()
If Application.DisplayCommentIndicator = xlCommentAndIndicator
Then
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Else
Application.DisplayCommentIndicator = xlCommentAndIndicator
End If
End Sub Application.DisplayCommentIndicator有三种状态:xlCommentAndIndicator-始终显示Comment标签、xlCommentIndicatorOnly-当鼠标指向单元格的Comment pointer时显示Comment标签、xlNoIndicator-隐藏Comment标签和单元格的Comment pointer。
4. 改变Comment标签的默认大小
Sub CommentFitter1()
With Range(
"A1").Comment
.Shape.Width =
150
.Shape.Height =
300
End With
End Sub 注意:旧版本中的Range.NoteText方法同样可以返回单元格中的Comment,按照Excel的帮助文档中的介绍,建议在新版本中统一使用Range.Comment方法。
返回目录
Cell Copy
1. 从一个Sheet中的Range拷贝数据到另一个Sheet中的Range
Private Sub CommandButton1_Click()
Dim myWorksheet
As Worksheet
Dim myWorksheetName
As String
myWorksheetName =
"MyName"
Sheets.Add.Name = myWorksheetName
Sheets(myWorksheetName).Move After:=Sheets(Sheets.Count)
Sheets(
"Sheet1").Range(
"A1:A5").Copy Sheets(myWorksheetName).Range(
"A1")
End Sub Sheets.Add.Name = myWorksheetName用于在Sheets集合中添加名称为myWorksheetName的Sheet,Sheets(myWorksheetName).Move After:=Sheets(Sheets.Count)将刚刚添加的这个Sheet移到Sheets集合中最后一个元素的后面,最后Range.Copy方法将数据拷贝到新表中对应的单元格中。
返回目录
Cell Format
1. 设置单元格文字的颜色
Sub fontColor()
Cells.Font.Color = vbRed
End Sub
Color的值可以通过RGB(0,225,0)这种方式获取,也可以使用Color常数:常数 | 值 | 描述 |
vbBlack | 0x0 | 黑色 |
vbRed | 0xFF | 红色 |
vbGreen | 0xFF00 | 绿色 |
vbYellow | 0xFFFF | 黄色 |
vbBlue | 0xFF0000 | 蓝色 |
vbMagenta | 0xFF00FF | 紫红色 |
vbCyan | 0xFFFF00 | 青色 |
vbWhite | 0xFFFFFF | 白色 |
2. 通过ColorIndex属性修改单元格字体的颜色
通过上面的方法外,还可以通过指定Range.Font.ColorIndex属性来修改单元格字体的颜色,该属性表示了调色板中颜色的索引值,也可以指定一个常量,xlColorIndexAutomatic(-4105)为自动配色,xlColorIndexNone(-4142)表示无色。
3. 一个Format单元格的例子
Sub cmd()
Cells(
1,
"D").Value =
"Text"
Cells(
1,
"D").Select
With Selection
.Font.Bold =
True
.Font.Name =
"Arial"
.Font.Size =
72
.Font.Color =
RGB(
0,
0,
255)
'Dark blue
.Columns.AutoFit
.Interior.Color =
RGB(
0,
255,
255)
'Cyan
.Borders.Weight = xlThick
.Borders.Color =
RGB(
0,
0,
255)
'Dark Blue
End With
End Sub 4. 指定单元格的边框样式
Sub UpdateBorder
range(
"A1").Borders(xlRight).LineStyle = xlLineStyleNone
range(
"A1").Borders(xlLeft).LineStyle = xlContinuous
range(
"A1").Borders(xlBottom).LineStyle = xlDashDot
range(
"A1").Borders(xlTop).LineStyle = xlDashDotDot
End Sub 如果要为Range的四个边框设置同样的样式,可以直接设置Range.Borders.LineStyle的值,该值为一个常数:
名称 | 值 | 描述 |
xlContinuous | 1 | 实线 |
xlDash | -4115 | 虚线 |
xlDashDot | 4 | 点划相间线 |
xlDashDotDot | 5 | 划线后跟两个点 |
xlDot | -4118 | 点式线 |
xlDouble | -4119 | 双线 |
xlLineStyleNone | -4142 | 无线 |
xlSlantDashDot | 13 | 倾斜的划线 |
返回目录
Cell Number Format
改变单元格数值的格式
Sub FormatCell()
Dim myVar
As Range
Set myVar = Selection
With myVar
.NumberFormat =
"#,##0.00_);[Red](#,##0.00)"
.Columns.AutoFit
End With
End Sub 单元格数值的格式有很多种,如数值、货币、日期等,具体的格式指定样式可以通过录制Excel宏得知,在Excel的Sheet中选中一个单元格,然后单击右键,选择“设置单元格格式”,在“数字”选项卡中进行选择。
返回目录
Cell Value
1. 使用STRConv函数转换Cell中的Value值
Sub STRConvDemo()
Cells(3, "A").Value = STRConv("ALL LOWERCASE ", vbLowerCase)
End Sub
STRConv是一个功能很强的系统函数,它可以按照指定的转换类型转换字符串值,如大小写转换、将字符串中的首字母大写、单双字节字符转换、平假名片假名转换、Unicode字符集转换等。具体的使用规则和参数类型读者可以查阅一下Excel自带的帮助文档,在帮助中输入STRConv,查看搜索结果中的第一项。
2. 使用Format函数进行字符串的大小写转换
Sub callLower()
Cells(2, "A").Value = Format("ALL LOWERCASE ", "<")
End Sub
Format也是一个非常常用的系统函数,它用于格式化输出字符串,有关Format的使用读者可以查看Excel自带的帮助文档。Format函数有很多的使用技巧,如本例给出的<可以将字符串转换为小写形式,相应地,>则可以将字符串转换为大写形式。
3. 一种引用单元格的快捷方法
Sub GetSum() ' using the shortcut approach
[A1].Value = Application.Sum([E1:E15])
End Sub
[A1]即等效于Range("A1"),这是一种引用单元格的快捷方法,在公式中同样也可以使用。
4. 计算单元格中的公式
Sub CalcCell()
Worksheets("Sheet1").range("A1").Calculate
End Sub
示例中的代码将计算Sheet1工作表中A1单元格的公式,相应地,Application.Calculate可以计算所有打开的工作簿中的公式。
5. 一个用于检查单元格数据类型的例子
Function CellType(Rng)
Application.Volatile
Set Rng = Rng.Range(
"A1")
Select Case True
Case IsEmpty(Rng)
CellType =
"Blank"
Case WorksheetFunction.IsText(Rng)
CellType =
"Text"
Case WorksheetFunction.IsLogical(Rng)
CellType =
"Logical"
Case WorksheetFunction.IsErr(Rng)
CellType =
"Error"
Case IsDate(Rng)
CellType =
"Date"
Case InStr(
1, Rng.Text,
":") <>
0
CellType =
"Time"
Case IsNumeric(Rng)
CellType =
"Value"
End Select
End Function Application.Volatile用于将用户自定义函数标记为易失性函数,有关该方法的具体应用,读者可以查阅Excel自带的帮助文档。
6. 一个Excel单元格行列变换的例子
Public Sub Transpose()
Dim I
As Integer
Dim J
As Integer
Dim transArray(
9,
2)
As Integer
For I =
1 To 3
For J =
1 To 10
transArray(J -
1, I -
1) = Cells(J,
Chr(I +
64)).Value
Next J
Next I
Range(
"A1:C10").ClearContents
For I =
1 To 3
For J =
1 To 10
Cells(I,
Chr(J +
64)).Value = transArray(J -
1, I -
1)
Next J
Next I
End Sub 该示例将A1:C10矩阵中的数据进行行列转换。
转换前:
转换后:
7. VBA中冒泡排序示例
Public Sub BubbleSort2()
Dim tempVar
As Integer
Dim anotherIteration
As Boolean
Dim I
As Integer
Dim myArray(
10)
As Integer
For I =
1 To 10
myArray(I -
1) = Cells(I,
"A").Value
Next I
Do
anotherIteration =
False
For I =
0 To 8
If myArray(I) > myArray(I +
1)
Then
tempVar = myArray(I)
myArray(I) = myArray(I +
1)
myArray(I +
1) = tempVar
anotherIteration =
True
End If
Next I
Loop While anotherIteration =
True
For I =
1 To 10
Cells(I,
"B").Value = myArray(I -
1)
Next I
End Sub 该实例将A1:A10中的数值按从小到大的顺序进行并,并输出到B1:B10的单元格中。
8. 一个验证Excel单元格数据输入规范的例子
Private Sub Worksheet_Change(ByVal Target
As Range)
Dim cellContents
As String
Dim valLength
As Integer
cellContents =
Trim(Str(Val(Target.Value)))
valLength =
Len(cellContents)
If valLength <>
3 Then
MsgBox (
"Please enter a 3 digit area code.")
Cells(
9,
"C").Select
Else
Cells(
9,
"C").Value = cellContents
Cells(
9,
"D").Select
End If
End Sub 重点看一下Val函数,该函数返回给定的字符串中的数字,数字之外的字符将被忽略掉,该示例用于检测用户单元格的输入值,如果输入值中包含的数字个数不等于3,则提示用户,否则就将其中的数字赋值给另一个单元格。
返回目录 Cell
1. 查找最后一个单元格
Sub GetLastCell()
Dim RealLastRow
As Long
Dim RealLastColumn
As Long
Range(
"A1").Select
On Error Resume Next
RealLastRow = Cells.Find(
"*", Range(
"A1"), xlFormulas, , xlByRows, xlPrevious).Row
RealLastColumn = Cells.Find(
"*", Range(
"A1"), xlFormulas, , xlByColumns, xlPrevious).Column
Cells(RealLastRow, RealLastColumn).Select
End Sub 该示例用来查找出当前工作表中的最后单元,并将其选中,主要使用了Cells对象的Find方法,有关该方法的详细说明读者可以参考Excel自带的帮助文档,搜索Cells.Find,见Range.Find方法的说明。2. 判断一个单元格是否为空
Sub ShadeEveryRowWithNotEmpty()
Dim i
As Integer
i =
1
Do Until
IsEmpty(Cells(i,
1))
Cells(i,
1).EntireRow.Interior.ColorIndex =
15
i = i +
1
Loop
End Sub IsEmpty函数本是用来判断变量是否已经初始化的,它也可以被用来判断单元格是否为空,该示例从A1单元格开始向下检查单元格,将其所在行的背景色设置成灰色,直到下一个单元格的内容为空。3. 判断当前单元格是否为空的另外一种方法
Sub IsActiveCellEmpty()
Dim sFunctionName
As String, sCellReference
As String
sFunctionName =
"ISBLANK"
sCellReference = ActiveCell.Address
MsgBox Evaluate(sFunctionName &
"(" & sCellReference &
")")
End Sub Evaluate方法用来计算给定的表达式,如计算一个公式Evaluate("Sin(45)"),该示例使用Evaluate方法计算ISBLANK表达式,该表达式用来判断指定的单元格是否为空,如Evaluate(ISBLANK(A1))。
4. 一个在给定的区域中找出数值最大的单元格的例子
Sub GoToMax()
Dim WorkRange
As range
If TypeName(Selection) <>
"Range" Then Exit Sub
If Selection.Count =
1 Then
Set WorkRange = Cells
Else
Set WorkRange = Selection
End If
MaxVal = Application.Max(WorkRange)
On Error Resume Next
WorkRange.Find(What:=MaxVal, _
After:=WorkRange.range(
"A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=
False _
).Select
If Err <>
0 Then MsgBox "Max value was not found: " _
& MaxVal
End Sub 5. 使用数组更快地填充单元格区域
Sub ArrayFillRange()
Dim TempArray()
As Integer
Dim TheRange
As range
CellsDown =
3
CellsAcross =
4
StartTime =
timer
ReDim TempArray(
1 To CellsDown,
1 To CellsAcross)
Set TheRange = ActiveCell.range(Cells(
1,
1), Cells(CellsDown, CellsAcross))
CurrVal =
0
Application.ScreenUpdating =
False
For I =
1 To CellsDown
For J =
1 To CellsAcross
TempArray(I, J) = CurrVal +
1
CurrVal = CurrVal +
1
Next J
Next I
TheRange.value = TempArray
Application.ScreenUpdating =
True
MsgBox Format(
timer - StartTime,
"00.00") &
" seconds"
End Sub 该示例展示了将一个二维数组直接赋值给一个“等效”单元格区域的方法,利用该方法可以使用数组直接填充单元格区域,结合下面这个直接在循环中填充单元格区域的方法,读者可以自己验证两种方法在效率上的差别。
Sub LoopFillRange()
Dim CurrRow
As Long, CurrCol
As Integer
Dim CurrVal
As Long
CellsDown =
3
CellsAcross =
4
StartTime =
timer
CurrVal =
1
Application.ScreenUpdating =
False
For CurrRow =
1 To CellsDown
For CurrCol =
1 To CellsAcross
ActiveCell.Offset(CurrRow -
1, _
CurrCol -
1).value = CurrVal
CurrVal = CurrVal +
1
Next CurrCol
Next CurrRow
' Display elapsed time
Application.ScreenUpdating =
True
MsgBox Format(
timer - StartTime,
"00.00") &
" seconds"
End Sub
![](//pubimage.360doc.com/wz/default.gif)
返回目录
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。