一、代码优化的一些方法
尽量减少在循环中遍历调用对象，公式计算
（操作VBA代码若出现屏幕闪屏，会拖慢运行速度），可以禁止屏幕闪屏。多用在操作工作表/薄，单元格的时候。
Application.ScreenUpdating = False
需声明变量类型，减少工作表函数的使用。（多写循环代替工作表函数）
减少VBA函数的使用，如int10000/3) 可以用10000 3 替代
单元格填充数据前先清空单元格数据
批量操作及减少循环次数
巧妙填充公式，如单元格的filldown方法向下复制，避开循环
cell2,a) = ” = b2*c2″
[a2:a100].FillDown
二、关于其他操作
1、字体及边框设置
Public Sub RngFont)
With Range"d3").Font
.Name = "华文彩云"
.FontStyle = "Bold"
.Size = 28
.ColorIndex = 3
.Underline = 5
End With
With Range"d3").Interior
.Pattern = xlPatternCrissCross '设置内部图案为十字图案
.PatternColorIndex = 6
End With
End Sub
2、单元格区域设置样式，borders方法，BorderAround 用于区域最外边框设置
Sub AddVBorders)
Dim rng As Range
Set rng = Range"a5:c9")
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
rng.BorderAround xlContinuous, xlMedium, 5
Set rng = Nothing
End Sub
BorderAround 后参数：
区域中多格式：
Sub bordersDemo)
Dim rng As Range
Set rng = Range"e5:g9")
With rng.BordersxlInsideHorizontal)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = 5
End With
With rng.BordersxlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
rng.BorderAround xlContinuous, xlMedium, 5
Set rng = Nothing
End Sub
3、行高、列宽设置 （磅或厘米）
Sub RngToPoints)
With Range"i14")
.RowHeight = Application.CentimetersToPoints1.2)
.ColumnWidth = Application.CentimetersToPoints0.8)
End With
With Range"j15")
.RowHeight = Application.InchesToPoints0.5)
.ColumnWidth = Application.InchesToPoints0.2)
End With
End Sub
样式如下：
4、单元格数据有效性设置 Validation对象add方法
Sub Validation)
'建立数据有效性
With Range"a1:a3").Validation
.Delete
.Add Type:=xlValidateList, _
Operator:=xlBetween, _
Formula1:="1,2,3,4,5,6,7" 'formula1,formula2可设置有效性公式
End With
'判断数据有效性
On Error GoTo Line
If Range"a1").Validation.Type >= 0 Then
MsgBox "have validation"
Exit Sub
End If
Line:
MsgBox "none"
End Sub
建立动态数据有效性:
Private Sub worksheet_SelectionchangeByVal target As Range)
If target.Column = 1 And target.Count = 1 And target.Row > 1 Then
With target.Validation
.Delete
.Add Type:=xlValidateList, _
Operator:=xlBetween, _
Formula1:="主机,显示器"
End With
End If
If target.Column = 2 Then
Application.SendKeys "%{down}" ' 点击单元格自动下拉展示所有选项
End If
End Sub
Private Sub worksheet_changeByVal target As Range)
If target.Column = 1 And target.Row > 1 And target.Count = 1 Then
With target.Offset0, 1).Validation
.Delete
Select Case target
Case "主机"
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="z286,z386,z486,z586"
Case "显示器"
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="三星1,飞利浦1,三星2,飞利浦2"
End Select
End With
End If
End Sub
效果：
5、检测选择区域是否含有公式（Hasformula函数），并输出公式位置
Private Sub CommandButton1_Click)
Select Case Selection.HasFormula
Case True
MsgBox "公式单元格"
Case False
MsgBox "非公式单元格"
Case Else
MsgBox "公式位置" & Selection.SpecialCellsxlCellTypeFormulas, 23).Address0, 0)
End Select
End Sub
若需要返回公式引用的单元格区域则使用公式单元格Precedents属性，exp: range”c1″).Precedents.address0,0)
6、判断是否为空
1）逻辑值判断 – 空时返回True
range”a1″)=””
lenrange”a1″)) = 0
VBA.IsEmptyrange”a1″))
2）值判断
VBA.TypeNamerange”a1″).Value) 值返回为Empty时为空
7、判断是否为数字、文本、错误值、数组、日期
1）逻辑值判断
VBA.IsNumericrange”c1″))
Application.WorkSheetFunction.IsNumberrange”c1″))
2) 值判断，不是返回Error–均用于判断数字和错误值
VBA.TypeNamerange”a1″).Value)
3）判断文本
Application.IsTextrange”a1″))
4）判断是否错误值
VBA.IsErrorrange”a1″).value)
5）数组判断
VBA.IsArrayarr)
6）日期判断
VBA.IsDaterange”a1″))
8、数据类型转换
类型装换函数：CBool,CByte,Ccur,CDate,CDbl,CDec,CInt,CLng,CSng,CStr,CVar
format , ) 函数可将一种类型格式化显示为数字或文本类型
exp: format234.5678,”0.00″)
9、日期时间常用处理方式
1）常用转换：
formatnow,”yyyy-mm-dd”) 如2002-12-11
formatnow,”yyyy年mm月dd天”)
formatnow,”yyyy年mm月dd天 h:mm:ss”)
formatnow,”d-mmm-yy”) 英文日期如19-Oct-02
formatnow,”d-mmmm-yy”) 英文日期月份完整拼写 如19-October-02
formatnow,”aaaa”) 中文日期星期几 如星期三
formatnow,”ddd”) 英文日期星期几（简写） 如Sat
formatnow,”dddd”) 英文日期星期几完整写法) 如Saturday
2）日期时间的连接
日期连接 VBA.DateSerial2011,10,1)
时间连接 VBA.TimeSerial1,2,1)
3) 日期时间返回 yearnow)
Year)函数、month)、day）、hour)、VBA.,Minute)、second)
4) 日期时间计算datediff,dateadd
datediff”yyyy”,d1,d2)
datediff”d”,d1,d2) 等等。。注意datediff”q”,d1,d2) q为计算季度差，对年计算时需要参数为4个yyyy，计算分钟时参数为n dateadd”n”,10,d1)
dateadd”d”,10,d1) 加10天 等等 。。 注意计算分钟时参数为n dateadd”n”,10,d1)，对年计算时需要参数为4个yyyy
5）制作一个简单计时器（application 的ontime函数）案例：注意设置doevents的意义为当前程序运行时允许其他程序运行，当公共变量k值改变则程序停止。
Option Explicit
Dim k
Public Sub clock)
Dim x
If k = 1 Then
k = 0
End
End If
With Range"c5").Font
.Name = "Times New Roman"
.FontStyle = "bold"
.Size = 28
.ColorIndex = 3
End With
With Range"c5").Interior
.Pattern = xlPatternCrissCross
.PatternColorIndex = 6
End With
Range"c5") = FormatNow, "h:mm:ss")
Application.OnTime Now + TimeValue"00:00:01"), "clock"
x = DoEvents '此处设置终止
End Sub
Sub stopclock)
k = 1
End Sub
Sub startclock)
Call clock
End Sub
效果：
10、随机抽取数据（换位）
案例1：
Sub rndSelect)
Dim arr
Dim x, num, k As Integer, sr As String
Range"c1:c10") = ""
Range"a1:a10") = Application.TransposeArray"A", "B", "C", "D", "E", "F", "G", "H", "I", "J"))
For x = 1 To 10
num = Rnd) * 10 - x) + 1) 1 '1 表示除1取整
Range"a1:a" & 10 - x + 1)).Interior.ColorIndex = xlNone
Range"a" & num).Interior.ColorIndex = 6
Range"c" & x) = Range"a" & num)
sr = Range"a" & num)
Range"a" & num) = Range"a" & 10 - x + 1))
Range"a" & 10 - x + 1)) = sr
Range"a" & 10 - x + 1)).Interior.ColorIndex = 3
Next x
End Sub
案例2 ： A列20000行数据A1,A2….A20000
不重复随机抽取的三种方式：1、字典 2、换位法（换取的A列数据为字符串）3、换位法优化（添加一维数组辅助交换，索引为1~20000的数组，值为对应的索引，此时交换的值为integer型）
Sub rndict)
'字典法
Dim d As Object
Set d = CreateObject"scripting.dictionary")
Dim arr, num As Integer, x As Integer, arr11 To 20000, 1 To 1) As String, t
t = Timer
arr = Range"a1:a20000")
For x = 1 To 20000
100:
num = Rnd) * 20000 - 1) + 1
If d.existsnum) Then
GoTo 100
Else
dnum) = ""
arr1x, 1) = arrnum, 1)
End If
Next x
Range"c1:c20000") = ""
Range"c1:c20000") = arr1
[d65535].EndxlUp).Offset1, 0) = Timer - t
End Sub
Sub rndSel)
' 换位法,换字符串效率相对低
Dim arr
Dim x, num As Integer, arr11 To 20000, 1 To 1), sr As String, t
t = Timer
arr = Range"a1:a20000")
For x = 1 To UBoundarr)
num = Rnd) * 20000 - x) + 1) 1
arr1x, 1) = arrnum, 1)
sr = arrnum, 1)
arrnum, 1) = arr20000 - x + 1, 1)
arr20000 - x + 1, 1) = sr
Next x
Range"c1:c20000") = ""
Range"c1:c20000") = arr1
[d65535].EndxlUp).Offset1, 0) = Timer - t
End Sub
Sub rndsel2)
'换位法，添加辅助数字列，换数字 提高运行效率
Dim arr
Dim arr11 To 20000, 1 To 1), sr As String
Dim x, num, arr21 To 20000) As Integer, t
t = Timer
arr = Range"a1:a20000")
For x = 1 To 20000
arr2x) = x
Next x
For x = 1 To UBoundarr)
num = Rnd) * 20000 - x) + 1)
arr1x, 1) = arrarr2num), 1)
sr = arr2num)
arr2num) = arr220000 - x + 1)
arr220000 - x + 1) = sr
Next x
Range"c1:c20000") = ""
Range"c1:c20000") = arr1
[d65535].EndxlUp).Offset1, 0) = Timer - t
End Sub
效果如下：
明显发现采用第三种方式效率更高。