Лучший способ запустить макрос для более чем 500K строк?

Question

У меня есть файл с кучей строк, который содержит данные для определенных номеров деталей из разных конфигураций. Некоторые из этих номеров деталей повторяются по всему файлу, и в этих дублированных номерах детали могут содержать определенные данные, а некоторые - нет. Я пытаюсь найти лучший способ определить общие черты в файле для определенных данных. Таким образом, для общностей, если одна строка имеет значение, а другая строка пуста, значение для непустой строки будет помещено в пустую строку. И если бы данные в этих двух строках были разными, это изменило бы цвет шрифта в ячейке, указывая на то, что в этой части номера два разных уникальных значения, и их следует проверить.

Dim i, j, n As Long
Dim lr As Long
Dim moaf As Workbook
Dim sht As Worksheet

Application.ScreenUpdating = False

Set moaf = Workbooks("MOAF3.xlsb")
Set sht = moaf.Worksheets("Wire Data")

n = InputBox("What column # are you trying to fill in?: ")
lr = Cells(Rows.count, 2).End(xlUp).Row

For i = 2 To lr
    lkup = Cells(i, 2).Value 'sets first lookup value
    Fill = Cells(i, n).Value 'sets the first data value to compare
    If Len(Fill) > 0 Then
        For j = 2 To lr
            lkup2 = Cells(j, 2).Value 'sets the second lookup value
            Fill2 = Cells(j, n).Value 'sets the second value to compare
            If lkup2 = lkup Then 'checks to see if p/ns are same
                If Len(Fill2) = 0 Then 'checks to see if second value is blank
                    Cells(j, n).Value = Fill 'if value is blank the cell takes value of non blank     cell
                ElseIf Fill <> Fill2 Then 'checks to see if the values are non matching and non zero
                    Cells(i, n).Font.ColorIndex = 3 'changes font color of two cells
                    Cells(j, n).Font.ColorIndex = 3 'changes font color of two cells
                End If
            End If
        Next j
    End If
Next i
Application.ScreenUpdating = True
End Sub

Выполнение этого обычно останавливает мой Excel, где мой компьютер имеет 32 ГБ оперативной памяти и Windows10. Есть ли лучший подход к моей проблеме, или это то, что можно сделать без использования VBA? Я провел некоторое исследование метода без использования vba, но с такими же суффиксами, счетчиками, но на самом деле не делал глубоких погружений.

Answer 1

Внутренний элемент для l oop просто должен начинаться с i, то есть:

for j = i to lr

Это должно составлять примерно половину времени выполнения.

Дальнейшие улучшения производительности: используйте свойство .Value2 вместо свойства .Value. Или, что еще лучше, прочитайте все столбцы в массив, поработайте над этим в VBA, а затем запишите результат обратно.

Answer 2

Итак, если я правильно понимаю ваш вопрос, вы начинаете со следующих данных:

ID Column_header
 2             a
 3       _BLANK_
 4       _BLANK_
 5             b
 6       _BLANK_

И вы хотите превратить это в:

ID Column_header
 2             a
 3             a
 4             a
 5             b
 6             b

Я знаю очень простой трюк для этого (я все объяснил в столбце «А»):

• Выберите каждую ячейку внутри этого столбца
• Перейти (Ctrl + G) Специально, Пробелы
• В строке формул введите =A2 (в данный момент вы находитесь в «A3» и хотите скопировать туда значение ячейки прямо над ней)
• Нажмите Ctrl + ENTER

Вы увидите, что «A2» копируется в «A3», «A3» в «A4» и «A5» в «A6» (факт, что это сделано для все пустые ячейки, из-за Ctrl + ENTER).

Запишите это в макрос, и оно будет go намного быстрее.

Я уже вижу вопрос: «Хорошо, а как насчет цвета шрифта, который я хочу изменить?». Итак, новые заполненные ячейки основаны на формуле, поэтому длина =FORMULATEXT() не будет равна нулю. Вы используете это как основу для условного форматирования.

Удачи