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

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