认沽期权的风险和盈利:cells
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