Fatal编程技术网
  • excel/
  • Excel 如何加速我的VBA脚本

Excel 如何加速我的VBA脚本

excel vba

Excel 如何加速我的VBA脚本,excel,vba,Excel,Vba,我有一张7800行、2382列的单张纸（大约1950万个单元格） 其中我有22个我真正感兴趣的列，其中有5个数字分散在其中 基本上，如果第一列中的一个数字出现在其他21 x列中，我想将相关行、列变成红色 我相信通过附加的代码，我已经实现了这一点，但运行大约需要3 x小时 我想首先问一下，这是否是一个合理的时间（3 x小时）与电子表格的大小 如果你希望这个程序能快得多，我真的很感激你对如何编写脚本的指导 Sub FindMatch() Dim rng_1 As Range Dim rng_2

我有一张7800行、2382列的单张纸（大约1950万个单元格）

其中我有22个我真正感兴趣的列，其中有5个数字分散在其中

基本上，如果第一列中的一个数字出现在其他21 x列中，我想将相关行、列变成红色

我相信通过附加的代码，我已经实现了这一点，但运行大约需要3 x小时

我想首先问一下，这是否是一个合理的时间（3 x小时）与电子表格的大小

如果你希望这个程序能快得多，我真的很感激你对如何编写脚本的指导

Sub FindMatch()


Dim rng_1 As Range
Dim rng_2 As Range
Dim rng_3 As Range
Dim rng_4 As Range
Dim rng_5 As Range
Dim rng_6 As Range
Dim rng_7 As Range
Dim rng_8 As Range
Dim rng_9 As Range
Dim rng_10 As Range
Dim rng_11 As Range
Dim rng_12 As Range
Dim rng_13 As Range
Dim rng_14 As Range
Dim rng_15 As Range
Dim rng_16 As Range
Dim rng_17 As Range
Dim rng_18 As Range
Dim rng_19 As Range
Dim rng_20 As Range
Dim rng_21 As Range
Dim rng_22 As Range



Dim rngRef_1 As Range
Dim rngRef_2 As Range
Dim rngRef_3 As Range
Dim rngRef_4 As Range
Dim rngRef_5 As Range
Dim rngRef_6 As Range
Dim rngRef_7 As Range
Dim rngRef_8 As Range
Dim rngRef_9 As Range
Dim rngRef_10 As Range
Dim rngRef_11 As Range
Dim rngRef_12 As Range
Dim rngRef_13 As Range
Dim rngRef_14 As Range
Dim rngRef_15 As Range
Dim rngRef_16 As Range
Dim rngRef_17 As Range
Dim rngRef_18 As Range
Dim rngRef_19 As Range
Dim rngRef_20 As Range
Dim rngRef_21 As Range
Dim rngRef_22 As Range


Application.Calculation = xlManual
Application.ScreenUpdating = False

Set rng_1 = Worksheets("Sheet1").Range("$DQ$2:$DQ$8000")
Set rng_2 = Worksheets("Sheet1").Range("$GW$2:$GW$8000")
Set rng_3 = Worksheets("Sheet1").Range("$KC$2:$KC$8000")
Set rng_4 = Worksheets("Sheet1").Range("$NI$2:$NI$8000")
Set rng_5 = Worksheets("Sheet1").Range("$QO$2:$QO$8000")
Set rng_6 = Worksheets("Sheet1").Range("$TU$2:$TU$8000")
Set rng_7 = Worksheets("Sheet1").Range("$XA$2:$XA$8000")
Set rng_8 = Worksheets("Sheet1").Range("$AAG$2:$AAG$8000")
Set rng_9 = Worksheets("Sheet1").Range("$ADM$2:$ADM$8000")
Set rng_10 = Worksheets("Sheet1").Range("$AGS$2:$AGS$8000")
Set rng_11 = Worksheets("Sheet1").Range("$AJY$2:$AJY$8000")
Set rng_12 = Worksheets("Sheet1").Range("$ANE$2:$ANE$8000")
Set rng_13 = Worksheets("Sheet1").Range("$AQK$2:$AQK$8000")
Set rng_14 = Worksheets("Sheet1").Range("$ATQ$2:$ATQ$8000")
Set rng_15 = Worksheets("Sheet1").Range("$AWW$2:$AWW$8000")
Set rng_16 = Worksheets("Sheet1").Range("$BAC$2:$BAC$8000")
Set rng_17 = Worksheets("Sheet1").Range("$BDI$2:$BDI$8000")
Set rng_18 = Worksheets("Sheet1").Range("$BGO$2:$BGO$8000")
Set rng_19 = Worksheets("Sheet1").Range("$BJU$2:$BJU$8000")
Set rng_20 = Worksheets("Sheet1").Range("$BNA$2:$BNA$8000")
Set rng_21 = Worksheets("Sheet1").Range("$BQG$2:$BQG$8000")
Set rng_22 = Worksheets("Sheet1").Range("$BTM$2:$BTM$8000")







Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_2 In rng_2
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_2.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_3 In rng_3
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_3.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_4 In rng_4
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_4.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next


Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_5 In rng_5
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_5.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_6 In rng_6
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_6.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_7 In rng_7
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_7.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next




Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_8 In rng_8
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_8.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_9 In rng_9
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_9.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_10 In rng_10
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_10.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next


Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_11 In rng_11
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_11.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_12 In rng_12
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_12.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_13 In rng_13
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_13.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next

Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_14 In rng_14
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_14.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next


Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_15 In rng_15
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_15.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_16 In rng_16
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_16.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_17 In rng_17
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_17.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next




Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_18 In rng_18
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_18.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_19 In rng_19
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_19.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_20 In rng_20
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_20.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next


Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_21 In rng_21
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_21.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------
 For Each rngRef_1 In rng_1
   For Each rngRef_22 In rng_22
     If rngRef_1.Value <> "" Then
       If rngRef_1.Value = rngRef_22.Value Then

        rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)

       End If
     End If
   Next
 Next
Rem -----------------------------------------------------



Application.Calculation = xlAutomatic
Application.ScreenUpdating = True


End Sub

子FindMatch（）
变暗rng_1作为范围
变光rng_2 As范围
变光rng_3 As范围
变暗rng_4 As范围
变光rng_5作为范围
变光rng_6作为范围
变暗rng_7作为范围
变光rng_8作为范围
变暗rng_9作为范围
尺寸rng_10作为范围
尺寸rng_11作为范围
尺寸rng_12 As范围
尺寸rng_13作为范围
尺寸rng_14作为范围
变暗rng_15作为范围
尺寸rng_16作为范围
变暗rng_17作为范围
尺寸rng_18作为范围
变暗rng_19 As范围
尺寸rng_20作为范围
尺寸rng_21作为范围
尺寸rng_22作为范围
变暗rngRef_1作为范围
变暗rngRef_2 As范围
变暗rngRef_3作为范围
变暗rngRef_4作为范围
变暗rngRef_5作为范围
变暗rngRef_6作为范围
变暗rngRef_7作为范围
变暗rngRef_8作为范围
变暗rngRef_9作为范围
变暗rngRef_10作为范围
变暗rngRef_11作为范围
变暗rngRef_12作为范围
变暗rngRef_13作为范围
尺寸rngRef_14作为范围
变暗rngRef_15作为范围
变暗rngRef_16作为范围
变暗rngRef_17作为范围
变暗rngRef_18作为范围
变暗rngRef_19作为范围
变暗rngRef_20作为范围
变暗rngRef_21作为范围
变暗rngRef_22作为范围
Application.Calculation=xlManual
Application.ScreenUpdating=False
设置rng_1=工作表（“表1”）。范围（$DQ$2:$DQ$8000）
设置rng_2=工作表（“表1”）。范围（$GW$2:$GW$8000）
集合rng_3=工作表（“表1”）。范围（$KC$2:$KC$8000）
Set rng_4=工作表（“表1”）。范围（$NI$2:$NI$8000）
Set rng_5=工作表（“表1”）。范围（$QO$2:$QO$8000）
Set rng_6=工作表（“表1”）。范围（$TU$2:$TU$8000）
集合rng_7=工作表（“表1”）。范围（$XA$2:$XA$8000）
设置rng_8=工作表（“表1”）。范围（$AAG$2:$AAG$8000）
Set rng_9=工作表（“表1”）。范围（$ADM$2:$ADM$8000）
集合rng_10=工作表（“表1”）。范围（$AGS$2:$AGS$8000）
Set rng_11=工作表（“表1”）。范围（$AJY$2:$AJY$8000）
Set rng_12=工作表（“表1”）。范围（$ANE$2:$ANE$8000）
Set rng_13=工作表（“表1”）。范围（$AQK$2:$AQK$8000）
Set rng_14=工作表（“表1”）。范围（$ATQ$2:$ATQ$8000）
设置rng_15=工作表（“表1”）。范围（$AWW$2:$AWW$8000）
Set rng_16=工作表（“表1”）。范围（$BAC$2:$BAC$8000）
Set rng_17=工作表（“表1”）。范围（$BDI$2:$BDI$8000）
Set rng_18=工作表（“表1”）。范围（$BGO$2:$BGO$8000）
Set rng_19=工作表（“表1”）。范围（$BJU$2:$BJU$8000）
Set rng_20=工作表（“表1”）。范围（$BNA$2:$BNA$8000）
设置rng_21=工作表（“表1”）。范围（$BQG$2:$BQG$8000）
设置rng_22=工作表（“表1”）。范围（$BTM$2:$BTM$8000）
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_2中的每个rngRef_2
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_2.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_3中的每个rngRef_3
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_3.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_4中的每个rngRef_4
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_4.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_5中的每个rngRef_5
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_5.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_6中的每个rngRef_6
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_6.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_7中的每个rngRef_7
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_7.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_8中的每个rngRef_8
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_8.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_9中的每个rngRef_9
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_9.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_10中的每个rngRef_10
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_10.Value，则
rngRef_1.偏移量（0，-120）.Interior.Color=RGB（255,0,0）
如果结束
如果结束
下一个
下一个
雷姆-----------------------------------------------------
对于rng_1中的每个rngRef_1
对于rng_11中的每个rngRef_11
如果rngRef_1.0值为“”，则
如果rngRef_1.Value=rngRef_11.Value，则
rngRef_1.偏移量（0，

For Each rngRef_1 In rng_1
    For Each rngRef_2 In rng_2
        If rngRef_1.Value <> "" Then
            If rngRef_1.Value = rngRef_2.Value Then
                rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
            End If
        End If
    Next
Next



For Each rngRef_1 In rng_1
   If Application.WorksheetFunction.CountIf(rng_2, rngRef_1.Value) > 0 Then _
   rngRef_1.Offset(0, -120).Interior.Color = RGB(255, 0, 0)
Next



GW = 205
NI = 373

and so on...

BTM = 1885



Option Explicit

Sub FindMatch()
    Dim ws As Worksheet
    Dim rng As Range, rngRef As Range, aCell As Range, colorMyRange As Range
    Dim nCalc As Long, i As Long

    On Error GoTo Whoa

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With Application
        nCalc = .Calculation
        .Calculation = xlManual
        .ScreenUpdating = False
    End With

    With ws
        Set rng = .Range("$DQ$2:$DQ$8000")

        For i = 205 To 1885 Step 84
            Set rngRef = .Range(.Cells(2, i), .Cells(8000, i))

            For Each aCell In rng
                If Application.WorksheetFunction.CountIf(rngRef, aCell.Value) > 0 Then
                    If colorMyRange Is Nothing Then
                        Set colorMyRange = aCell.Offset(0, -120)
                    Else
                        Set colorMyRange = Union(colorMyRange, aCell.Offset(0, -120))
                    End If
                End If

            Next

            If Not colorMyRange Is Nothing Then
                colorMyRange.Interior.Color = RGB(255, 0, 0)
                Set colorMyRange = Nothing
            End If
        Next i
    End With

LetsContinue:

    With Application
        .Calculation = nCalc
        .ScreenUpdating = True
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub