Sub test()
Application.ScreenUpdating = False
Dim arr
Dim brr
Dim i As Integer
Dim j As Byte
Dim t As Long
Dim rng As Range
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
t = Timer
Set rng = Cells.Find("昆山", ActiveCell, , xlPart)
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
If InStr(1, arr(i, 3), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 3))
End If
If InStr(1, arr(i, 4), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 4))
End If
If InStr(1, arr(i, 9), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 9))
End If
If InStr(1, arr(i, 10), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 10))
End If
If InStr(1, arr(i, 11), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 11))
End If
If InStr(1, arr(i, 12), "昆山", vbTextCompare) > 0 Then
Set rng = Union(rng, Cells(i, 12))
End If
Next i
rng.Select
MsgBox Format(Timer - t, "0.00")
End Sub
看來沒辦法,最直接也就這樣了,也要10秒多
主要都是太多ole,沒法快了
做功,一般都是運算計算吧,像這種要指家格的操作,應該只會做一兩次
你要經常這種操作?為什麼? |