Как исправить переполнение на диапазоне строк 700К

Question

Как часть более крупного макроса, код должен проверять, начинается ли ячейка в столбце D цифрой 6. Если это так, скопируйте символы Mid 5, начиная со 2-го (по сути, пропустите 6), и еслине начинается с 6, просто скопируйте первые 5 символов слева и вставьте в соседнюю ячейку в столбце E.

Я получаю ошибку переполнения, я предполагаю, потому что документ имеет длину 700К строк.Какие-нибудь предложения относительно того, как я могу это исправить?

Sub Left_Function()

Dim sourceRang As Range, destinationRange As Range, i As Integer, LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
Set SourceRange = Sheet1.Range("D1:LastRow")
Set desinationRange = Sheet1.Range("E1:LastRow")
For i = 1 To SourceRange.Count
    For Each cell In SourceRange
        If Left(cell.Value, 1) = "6" Then
            destinationRange(i, 1).Value = Mid(SourceRange(i, 1).Value, 2, 5)
        Else: destinationRange(i, 1).Value = Left(SourceRange(i, 1).Value, 5)
        End If
    Next cell
Next i

End Sub

Я не очень хорош в VBA, так что это довольно патч-работа, основанная на вещах, которые я погуглил, так что если у вас есть альтернативный фрагмент кодатогда у меня все уши.

Answer 1

В вашем коде много проблем

• Неправильное использование типа данных (целое число вместо длинного)
• Неверное определение диапазона Range("D1:LastRow")
• много опечаток в именах переменных и ссылках на объекты
• Несогласованные Worksheet ссылки (ActiveSheet могут или не могут быть Sheet1)
• Неосновная вложенность цикла For (это приведет к потере времени выполнения)
• Для такого большого набора данных непосредственное зацикливание диапазона сделает код очень медленным

Исправление этих проблем и преобразование в подход с использованием Variant Array:

Option Explicit

Sub Left_Function()
    Dim ws As Worksheet
    Dim sourceRange As Range, destinationRange As Range
    Dim i As Long
    Dim src As Variant, dst As Variant

    Set ws = ActiveSheet
    With ws
        Set sourceRange = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
        Set destinationRange = sourceRange.Offset(0, 1)
        src = sourceRange.Value
        ReDim dst(1 To UBound(src, 1), 1 To 1)

        For i = 1 To UBound(src, 1)
            dst(i, 1) = Mid$(src(i, 1), IIf(Left$(src(i, 1), 1) = "6", 2, 1), 5)
        Next

        destinationRange = dst
    End With
End Sub

Answer 2

Я думаю, что причина вашего переполнения в том, что вы указали i и LastRow как тип Int. Int имеет максимум 32767, поэтому, если у вас есть 700К строк, вы получите переполнение. Чтобы исправить это, измените тип на Long.

Кроме того, способ инициализации SourceRange и destinationRange выглядит неправильно по нескольким причинам - такое выражение, как "D1:LastRow", является просто строковым литералом и не дает допустимого диапазона в Excel.

Вам нужно что-то вроде этого:

Sheet1.Range("D1:D" & CStr(LastRow))

Здесь есть 3 тонких изменения. Сначала CStr(LastRow) преобразует числовое значение LastRow в его строковый эквивалент. Во-вторых, & объединяет строки (вы также можете использовать +). В-третьих, обратите внимание на необходимость явно указать столбец для начала и конца диапазона: D1: 100 недопустимо (только один D); но D1: D100 будет работать.

Надеюсь, это поможет.