Оптимизация для Excel

Question

Вот ситуация: на моем листе Excel у меня был столбец с записями в форме 1-name. Я хотел удалить цифры, принимая во внимание, что число может также быть двузначным. Это само по себе не было проблемой, и я получил ее работу, просто производительность настолько плоха. Как и сейчас, моей программе требуется около половины секунды на запись в ячейку.

Мой вопрос: как я могу улучшить производительность? Вот код:

Sub remove_numbers() 
    Dim YDim As Long 
    Dim i As Integer, l As Integer 
    Dim val As String 
    Dim s As String 
    YDim = Cells(Rows.Count, 5).End(xlUp).Row 
    For i = 8 To YDim 
     val = Cells(i, 5) 
     l = Len(val) 
     s = Mid(val, 2, 1) 
     If s = "-" Then 
      val = Right(val, l - 2) 
     Else 
      val = Right(val, l - 3) 
     End If 
     Cells(i, 5).Value = val 
    Next i 
End Sub 

Answer 1

Вместо того, чтобы использовать 3 различных функций: Len(), Mid(), Right() можно использовать Split() функцию, которая была бы гораздо более эффективным в данном случае.

Попробуйте приведенный ниже код

Sub remove_numbers() 
    Application.ScreenUpdating = False 
    Dim i As Long 
    For i = 8 To Cells(Rows.Count, 5).End(xlUp).Row 
     Cells(i, 5) = Split(Cells(i, 5), "-")(1) 
    Next i 
    Application.ScreenUpdating = True 
End Sub 

Answer 2

Вы должны манипулировать значения всего спектра как массив и работать непосредственно с ним в памяти.

Что-то вроде:

Dim valuesOfRangeToModify() As Variant 
Set valuesOfRangeToModify = Range(Cells(8, 5), Cells(Rows.Count, 5).End(xlUp)).Value 
For Each cell In valuesOfRangeToModify 
    cell = ... // remove numbers 
Next 

Range(Cells(8, 5), Cells(Rows.Count, 5).End(xlUp)).Value = valuesOfRangeToModify 

Мой VB довольно старая, так что, вероятно, имеет синтаксические ошибки, но вы получите идею.
Это должно дать огромный импульс.

Для справки, вот статья полна интересных советов, смотри пункт № 4 для более подробного объяснения решения приведенного выше: http://www.soa.org/news-and-publications/newsletters/compact/2012/january/com-2012-iss42-roper.aspx

Answer 3

Мое предложение:

Sub remove_numbers() 
    Dim i As Integer, values() As Variant 
    values = Range(Cells(8, 5), Cells(Rows.Count, 5).End(xlUp).Row).Value 
    For i = LBound(values) To UBound(values) 
     values(i, 1) = Mid(values(i, 1), IIf(Mid(values(i, 1), 2, 1) = "-", 2, 3)) 
    Next 
    Range(Cells(8, 5), Cells(Rows.Count, 5).End(xlUp).Row).Value = values 
End Sub 

Optimizations:

• Выполнение всех расчетов в памяти и их обновление всего диапазона: это ОГРОМНОЕ усиление производительности;
• Конденсированные несколько команд в одну команду;
• Заменено Right(x, Len(x)-n)Mid(x, n).

EDIT:

По предложению @Mehow, вы можете также получить некоторую производительность с помощью

values(i, 1) = Split(values(i, 1), "-", 2)(1) 

вместо values(i, 1) = Mid(values(i, 1), IIf(Mid(values(i, 1), 2, 1) = "-", 2, 3))

Answer 4

Также не работают на одну клетку за один раз. Создайте диапазон ячеек и перенесите их в массив для обработки. В конце концов массив можно использовать для замены ячеек.

Чтобы настроить ответ от @mehow

Sub remove_numbers() 
    Dim i As Long, N as Long, r as Range 
    Set r = Range("B3") ' Whatever is the first cell in the column 
    N = Range(r, r.End(xlDown)).Rows.Count 'Count the rows in the column 
    Set r = r.Resize(N,1) ' Expand the range with all the cells 
    Dim values() as Variant 
    values = r.Value ' Collect all the values from the sheet 
    For i=1 to N 
     values(i,1) = Split(values(i,1), "-")(1) 
    Next i 
    r.Value = values 'Replace values to the sheet 
End Sub 

Чтобы сделать его более общий, вы можете добавить аргумент к процедуре передать ссылку на первую ячейку в столбце, как Sub remove_numbers(ByRef r as Range). Нет необходимости деактивировать экран, поскольку в конце есть только одна операция записи, и вы хотите, чтобы экран обновлялся после этого.