Оптимизация цикла для VBA Macro Excel 2007

Question

У меня есть этот код, который работает. он идет вниз по диапазону и удаляет пустые строки, разделяет первый символ в другой столбец, если это не число или знак минус.
Этот код работает. но это слишком МЕДЛЕННО для количества данных, с которыми мне нужно иметь дело. Спасибо всем за ваше предложение о том, как оптимизировать этот код и сделать его быстрее.

Я уже отключил автоматические вычисления. обновление экрана. и видимость приложения.

Dim rng As Range
Dim i As Long
Dim Tracking As Long

Dim textval As String
Dim limitz As String
Dim remaining As String

Range("B1").End(xlDown).Offset(0, 5).Select

Set rng = Range("G2", ActiveCell).Select

i = 1
Range("G2").Select

For Tracking = 1 To rng.Rows.Count

    textval = rng.Cells(i).Value
    limitz = Left(textval, 1)

    If limitz = "" Then
      rng.Cells(i).EntireRow.Delete
     ElseIf limitz <> "0" And limitz <> "1" And limitz <> "2" And limitz <> "3" And limitz <> "4" And limitz <> "5" And limitz <> "6" And limitz <> "7" And limitz <> "8" And limitz <> "9" And limitz <> "-" Then
      remaining = Right(textval, Len(textval) - 1)
      rng.Cells(i) = remaining
      rng.Cells(i).Offset(0, 1).Value = limitz
      i = i + 1
     Else
      i = i + 1
    End If

Next

Answer 1

Не так много кода, который кажется явно неэффективным .

Вот несколько советов о том, что я могу сказать:

• Не выбирайте ячейки , если только вы действительно не вынуждены (поскольку это не в вашем цикле, это не самое плохое)
• Попробуйте проанализировать range вместо использования Long
• Измените свой тест с помощью выражения vba, например IsNumeric
• Используйте With, чтобы избежать многократного вызова объекта

Вот попытка (возможно, я изменил некоторое поведение, потому что не мог понять, хотите ли вы разобрать ячейки или строки):

Sub test()
  Dim rng As Range, row As Range
  Dim i As Long

  Dim textval As String
  Dim limitz As String
  Dim remaining As String

  Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5))
  i = 1

  For Each row In rng.Rows
      With row
        textval = .Cells(i).Value
        limitz = Left(textval, 1)

        If limitz = "" Then
            .Cells(i).EntireRow.Delete
        ElseIf limitz <> "-" And Not IsNumeric(limitz) Then
          remaining = Right(textval, Len(textval) - 1)
          With .Cells(i)
            .Value = remaining
            .Offset(0, 1).Value = limitz
          End With
          i = i + 1
         Else
          i = i + 1
        End If
      End With
  Next
End Sub

Answer 2

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

Сбор всех данных в одном варианте делает это намного быстрее, поскольку VBA не слишком сильно взаимодействует с Excel.Использование специальных ячеек также делает это.Использование «like» очищает код, не знаю, лучше ли производительность для этого.

Dim rng As Range
Dim vData As Variant
Dim i As Long
Dim limitz As String

Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5).Address)

'Delete empty cells
On Error Resume Next
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

'Get all data in range
vData = rng.Resize(, 2)

For i = 1 To UBound(vData)

    limitz = Left$(CStr(vData(i, 1)), 1)

    If limitz Like "[!0-9,!-]" Then
      vData(i, 1) = Right$(CStr(vData(i, 1)), Len(vData(i, 1)) - 1)
      vData(i, 2) = limitz
    End If
Next

rng.Resize(, 2) = vData

Следующий код не проверен, но должен работать и работать довольно быстро.Следует отметить, что удаление целых строк довольно затратно (по времени), хотя вы можете минимизировать время, используя метод, описанный ниже, это все равно займет некоторое время, и вы ничего не можете с этим поделать:*

Answer 3

Вы должны обрабатывать свои строки снизу вверх: должно быть быстрее, потому что каждое удаление приводит к уменьшению количества строк вверх.

Непроверенные:

Sub test()

    Dim rng As Range, c As Range
    Dim numRows As Long
    Dim Tracking As Long

    Dim textval As String
    Dim limitz As String

    Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5))
    numRows = rng.Rows.Count

    For Tracking = numRows To 1 Step -1

        Set c = rng.Cells(Tracking)
        textval = c.Value
        limitz = Left(textval, 1)

        If limitz = "" Then
          c.EntireRow.Delete
        ElseIf Not limitz Like "[0-9-]" Then
          c.Value = Right(textval, Len(textval) - 1)
          c.Offset(0, 1).Value = limitz
        End If

    Next

End Sub