Создание цикла «Для каждого» быстрее

Я сделал следующий код, однако для его выполнения требуются возраста. Мне интересно, может ли быть более быстрый способ. Я хочу скопировать форматирование (BG Color) из диапазона M2: M60, если оно соответствует любым ячейкам в 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

Попробуй это. Это должно быть мгновенно:

 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 

Я бы подумал, что работа с блоками массивов в памяти была бы самым быстрым маршрутом, но это либо связывает, либо бьет вложенное 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 в группах, а не отдельно.

Давайте будем гением компьютера.