网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
vba吧 关注：17,050贴子：66,687
  • 2回复贴，共1页

求教各位,如何提高下列代码的运行速度.

Private Sub Command10_Click()
Me.Label3.Caption = Me.Label3.Caption + 1
Dim arr1 As Excel.Range, arr2 As Excel.Range
Dim i As Long, j As Long, k As Long, g As Long
Dim arrsht1 As Excel.Worksheet, arrsht2 As Excel.Worksheet
If dkgzb Is Nothing Then Exit Sub
Me.WindowState = 1
dkapp.WindowState = xlMaximized
On Error GoTo 102
Set arr1 = dkgzb.Application.InputBox("请选择第1列条件数据.", "对比条件列选取", Type:=8)
Set arrsht1 = dkgzb.ActiveSheet
If arr1.Rows.Count > 30000 Then
Set arr1 = arrsht1.Range(arr1(1, 1).Address & ":" & arrsht1.Cells(arr1.SpecialCells(xlCellTypeLastCell).Row, arr1.Columns.Count).Address)
End If
Set arr2 = dkgzb.Application.InputBox("请选择第2列对比数据.", "对比条件列选取", Type:=8)
Set arrsht2 = dkgzb.ActiveSheet
If arr2.Rows.Count > 30000 Then
Set arr2 = arrsht2.Range(arr2(1, 1).Address & ":" & arrsht2.Cells(arr2.SpecialCells(xlCellTypeLastCell).Row, arr2.Columns.Count).Address)
End If
' dkgzb.Application.ScreenUpdating = False
arr1.Interior.ColorIndex = xlNone
arr2.Interior.ColorIndex = xlNone
If arr1.Address = arr2.Address Then '单个区域重复值上色
For i = 1 To arr1.Rows.Count
For j = 1 To arr1.Columns.Count
If dkgzb.Application.WorksheetFunction.CountIf(arr1, arr1(i, j)) > 1 Then arr1(i, j).Interior.ColorIndex = 38
Next
Next
GoTo 102
End If
For i = 1 To arr1.Rows.Count '两个区域标记重复值
For j = 1 To arr1.Columns.Count
For k = 1 To arr2.Rows.Count
For g = 1 To arr2.Columns.Count
If arr1(i, j) = arr2(k, g) And arr1(i, j) <> "" And arr2(k, g) <> "" Then
arr1(i, j).Interior.ColorIndex = 38
arr2(k, g).Interior.ColorIndex = 38
End If
Next g
Next k
Next j
Next i
Me.WindowState = 1
dkapp.WindowState = xlMaximized
102
' dkgzb.Application.ScreenUpdating = True
End Sub


你全部是使用单元格来循环，速度是会很慢的，比如两区域比较的四重循环：
For i = 1 To arr1.Rows.Count '两个区域标记重复值
For j = 1 To arr1.Columns.Count
For k = 1 To arr2.Rows.Count
For g = 1 To arr2.Columns.Count
在数据量很大的情况下，直接读取单元格很影响速度。常用的方法有两种：
1、数组：
把两个区域的数据全部先写入数组，然后利用数组来比较。数组的速度远快于单元格，虽然循环次数还是一样的，但总体速度快很多。把你代码稍微变换下：
dim arr1,arr2 '这里定义的参数是数组，与上面的range不同，可以换成其他的变量名
arr1=range("第一个区域的范围")
arr2=range("第二个区域的范围")
For i = 1 To arr1.ubound(arr1,1)
For j = 1 To arr1.ubound(arr1,2)
For k = 1 To arr2.ubund(arr2,1)
For g = 1 To arr2.ubound(arr2,2)
If arr1(i, j) = arr2(k, g) And arr1(i, j) <> "" And arr2(k, g) <> "" Then
2、字典或者字典+数组：
先把第一个区域写入字典，第二个区域写入数组，写入数组的方法跟上面的相同，下面说下写入字典的方法：
dim zd as object 'object是所有组件的父对象，搞不清细节的对象都可以定义为object
set zd=createobiect("scripting.dictionary") '没有变通，只能这么写，是固定的
然后是写入字典：
for i=2 to [a100000].end(3).row '读取所有的行
for k=[a1].end(2).column '读取所有的列
s=cells(i,k)
zd(s)=s '写入字典，左边是key，右边是item
next k
next i
字典的要求是不能有重复值，如果有会自动去重。因为你前面的判断条件有
If arr1(i, j) = arr2(k, g) And arr1(i, j) <> "" And arr2(k, g) <> "" Then
这表明区域数据是有重复的“空”值存在的，因此你这个例子并不适合用字典。在没有重复值的前提下，下面的比较才是成立的：
for i=1 to ubound(arr,1)
for k=1 to ubound(arr,2)
if zd.exists(arr(i,k)) then '字典的exists能立即判断arr(i,k)是否存在于字典内
next k
next i
字典的exists比循环判断要快很多，不仅代码简洁，速度还快。大多数情况下比数组要快，数据量越大快得越多。但要注意：字典不能用于重复值的判断，只能用于非重复值的场合。


扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！
  • 2回复贴，共1页
分享到: