Макрос VBA падает после 32000 строк

У меня есть макрос VBA, который копирует строки из одного листа в другой, основываясь на поиске значений в ячейках в 3 столбцах. Макрос работает, но падает, когда он достигает строки 32767. В этой строке нет формул или специального форматирования. Кроме того, я выбрал эту строку, но она по-прежнему падает на этот номер строки. Это ограничение в excel? В листе, который является процессом, находится около 43000.

Поэтому я спрашиваю, что не так с моим макросом и как я могу дотянуться до конца рабочего листа:

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim wks As Worksheet
On Error GoTo Err_Execute

Для каждого wks In Worksheets

LSearchRow = 4
LCopyToRow = 4

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set wksCopyTo = ActiveSheet
wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0

    If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then

        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy


        wksCopyTo.Select
        wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        wksCopyTo.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1
        'Go back to Sheet1 to continue searching
        wks.Select
    End If
    LSearchRow = LSearchRow + 1
Wend

Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Next wks
    Exit Sub
Err_Execute:
    MsgBox "An error occurred."

Пожалуйста, помогите!

Ответы

Ответ 1

Тип VBA 'Int' является подписанным 16-битовым полем, поэтому он может содержать только значения от -32768 до +32767. Измените эти переменные на "Long", который является подписанным 32-битным полем и может содержать значения от -2147483648 до +2147483647. Должно быть достаточно для Excel.;)

Ответ 2

Это звучит как целочисленная проблема

Целочисленные и длинные типы данных могут содержать как положительные, так и отрицательные значения. Разница между ними - их размер: Целочисленные переменные может содержать значения между -32,768 и 32,767, в то время как длинные переменные могут от -2,147,483,648 до 2,147,483,647.

Но какую версию вы используете? Потому что:

Традиционно VBA программисты использовали целые числа для хранения небольших чисел, поскольку они требуется меньше памяти. Однако в последних версиях VBA конвертирует все целочисленные значения типа Long, даже если они объявлены как тип Целое число.. Поэтому больше нет преимущества производительности для используя переменные Integer; на самом деле, длинные переменные могут быть немного быстрее, потому что VBA не нужно их преобразовывать.

Эта информация находится непосредственно из MSDN

UPDATE

Пожалуйста, также прочитайте первый комментарий! Я неправильно интерпретировал информацию MSDN!

Thats MSDN вводит в заблуждение: VBA сам не конвертирует Integer в Длинный. Под крышками CPU преобразует целое число в long, делает ли а затем преобразует полученную длинную назад в целую. Так Целые числа VBA по-прежнему не могут содержать числа, большие 32K - Charles Williams

Ответ 3

Вы можете избежать проблемы с Integer vs. Long, используя строку "Для каждого", а не увеличивающиеся строки. Для каждого, как правило, быстрее, так как это исключает выбор диапазонов. Вот пример:

Sub CopySheets()

    Dim shSource As Worksheet
    Dim shDest As Worksheet
    Dim rCell As Range
    Dim aSheets() As Worksheet
    Dim lShtCnt As Long
    Dim i As Long

    Const sDESTPREFIX As String = "dest_"

    On Error GoTo Err_Execute

    For Each shSource In ThisWorkbook.Worksheets
        lShtCnt = lShtCnt + 1
        ReDim Preserve aSheets(1 To lShtCnt)
        Set aSheets(lShtCnt) = shSource
    Next shSource

    For i = LBound(aSheets) To UBound(aSheets)
        Set shSource = aSheets(i)

        'Add a new sheet
        With ThisWorkbook
            Set shDest = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
            shDest.Name = sDESTPREFIX & shSource.Name
        End With

        'copy header row
        shSource.Rows(3).Copy shDest.Rows(3)

        'loop through the cells in column a
        For Each rCell In shSource.Range("A4", shSource.Cells(shSource.Rows.Count, 1).End(xlUp)).Cells
            If Not IsEmpty(rCell.Value) And _
                rCell.Offset(0, 27).Value = "Yes" And _
                rCell.Offset(0, 36).Value = "Yes" And _
                rCell.Offset(0, 53).Value = "Yes" Then

                'copy the row
                rCell.EntireRow.Copy shDest.Range(rCell.Address).EntireRow
            End If
        Next rCell
    Next i

    MsgBox "All matching data has been copied."

Err_Exit:
    'do this stuff even if an error occurs
    On Error Resume Next
    Application.CutCopyMode = False
    Exit Sub

Err_Execute:
    MsgBox "An error occurred."
    Resume Err_Exit

End Sub