Question

我已经制作了以下代码，但是需要很长时间才能完成。我想知道是否有更快的方法。我想从范围M2：M60复制格式（BG颜色），如果它匹配C2：K280中的任何单元格。我可以进行条件格式化，但是因为我需要输入60多个可能改变的项目，希望我可以使用VBA。

Sub CopyColors()
    Dim FoundCell As Range
    Dim Search As String
    Dim Searchrng As Range, cell As Range


Set Searchrng = Sheets("Tally").Range("M2:M60")

For Each cell In Searchrng
    For Each FoundCell In Sheets("Tally").Range("C2:K280")
        If FoundCell = cell Then
            cell.Copy
            FoundCell.PasteSpecial xlPasteFormats
        Else

        End If
    Next FoundCell
Next cell

Range("C2").Select

End Sub

-Cr1kk0

Answer 1

试试这个。它应该是瞬间的：

Sub CopyColors()

    Dim i&, j&, k&, m, n, s As Range, f As Range

    Set s = [tally!m2:m60]
    Set f = [tally!c2:k280]
    m = s.Value2
    n = f.Value2

    For k = 1 To UBound(m)
        With s(k)
            For i = 1 To UBound(n, 1)
                For j = 1 To UBound(n, 2)
                    If LenB(m(k, 1)) Then
                        If LenB(n(i, j)) Then
                            If m(k, 1) = n(i, j) Then
                                f(i, j).Interior.Color = .DisplayFormat.Interior.Color
                            End If
                        End If
                    End If
                Next
            Next
        End With
    Next

End Sub

Answer 2

我原本以为在内存中处理数组块本来就是最快的路径，但这要么通过数组连接或击败嵌套的For ... Next循环几毫秒。

Sub Find_FindNext_Colors()
    Dim rTHIS As Range, rTHAT As Range, rTHOSE As Range

    Debug.Print Timer

    With Worksheets("Tally")
        With .Range("C2:K280, M2:M280")  '<~~in the union, M has to be same size as C:K
            For Each rTHIS In .Parent.Range("M2:M60") '<~~only M2:M60
                Set rTHAT = .Find(What:=rTHIS.Value2, After:=.Parent.Range("M60"), LookAt:=xlWhole, _
                                  SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                  MatchCase:=False, SearchFormat:=False)
                Set rTHOSE = rTHAT
                Do While rTHAT.Column < rTHIS.Column
                    Set rTHOSE = Union(rTHOSE, rTHAT)
                    Set rTHAT = .FindNext(After:=rTHAT)
                Loop
                rTHOSE.Interior.Color = rTHIS.DisplayFormat.Interior.Color
            Next rTHIS
        End With
    End With

    Debug.Print Timer

End Sub

我相信通过分组而不是单独分配Range.Interior.Color property来节省几毫秒。

制作＆＃39; For Each＆＃39;循环更快

2 个答案: