Excel VBA: ошибка времени выполнения 7: вне памяти

Буду признателен, если кто-нибудь может помочь мне в этом вопросе, который у меня есть. В принципе, VBA – это функция поиска, которая позволяет пользователю выполнять поиск части или всего имени задания из базы данных заданий.

Однако это приводит к ошибке Runtime 7: Out of Memory. Это происходит только на моем Macbook и не происходит на компьютере под управлением Windows. После нажатия «debug» он привел меня к этой строке кода:

`If scd.Cells(i, j) Like "*" & Search & "*" Then 

пожалуйста помоги! Спасибо!

Остальная часть кода приведена ниже:

 Option Compare Text Sub SearchClientRecord() Dim Search As String Dim Finalrow As Integer Dim SearchFinalRow As Integer Dim i As Integer Dim scs As Worksheet Dim scd As Worksheet Set scs = Sheets("Client Search") Set scd = Sheets("Client Database") scs.Range("C19:S1018").ClearContents Search = scs.Range("C12") Finalrow = scd.Range("D100000").End(xlUp).Row SearchFinalRow = scs.Range("D100000").End(xlUp).Row For j = 3 To 19 For i = 19 To Finalrow If scd.Cells(i, j) Like "*" & Search & "*" Then scd.Range(scd.Cells(i, 3), scd.Cells(i, 19)).Copy scs.Range("C100000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats End If Next i Next j scs.Range("C19:S1018").Select scs.Range("$C$18:$S$1009").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _ , 7), Header:=xlYes Call Border Columns("C:S").HorizontalAlignment = xlCenter End Sub 

Я создал альтернативную функцию под названием «aLike» ниже. В вашем коде вы использовали бы его, сказав: If aLike("*" & Search & "*",scd.Cells(i, j)) Then я не могу гарантировать, что он работает точно так же, но мне было бы интересно чтобы убедиться, что Mac может обрабатывать эту функцию лучше, чем «нравится».

 Function aLike(asterixString As Variant, matchString As Variant, Optional MatchCaseBoolean As Boolean) As Boolean Dim aStr As Variant, mStr As Variant, aStrList As New Collection Dim i As Long, aPart As Variant, mPart As Variant, TempInt As Long, aStart As Boolean, aEnd As Boolean aStr = asterixString: mStr = matchString If Not MatchCaseBoolean Then aStr = StrConv(aStr, vbLowerCase): mStr = StrConv(mStr, vbLowerCase) ' Get rid of excess asterix's While InStr(aStr, "**") > 0 aStr = Replace(aStr, "**", "*") Wend ' Deal with trivial case If aStr = mStr Then aLike = True: GoTo EndFunction If aStr = "*" Then aLike = True: GoTo EndFunction If Len(aStr) = 0 Then aLike = False: GoTo EndFunction ' Convert to list aStart = Left(aStr, 1) = "*": If aStart Then aStr = Right(aStr, Len(aStr) - 1) aEnd = Right(aStr, 1) = "*": If aEnd Then aStr = Left(aStr, Len(aStr) - 1) aLike_Parts aStr, aStrList ' Check beginning If Not aStart Then aPart = aStrList.Item(1) If Not (aPart = Left(mStr, Len(aPart))) Then aLike = False: GoTo EndFunction End If ' Check end If Not aEnd Then aPart = aStrList.Item(aStrList.Count) If Not (aPart = Right(mStr, Len(aPart))) Then aLike = False: GoTo EndFunction End If ' Check parts mPart = mStr For i = 1 To aStrList.Count aPart = aStrList.Item(i): TempInt = InStr(mPart, aPart) If TempInt = 0 Then aLike = False: GoTo EndFunction mPart = Right(mPart, Len(mPart) - TempInt - Len(aPart) + 1) If Len(mPart) = 0 And i < aStrList.Count Then aLike = False: GoTo EndFunction Next i aLike = True EndFunction: Set aStrList = Nothing End Function Function aLike_Parts(Str As Variant, StrList As Collection) As Variant Dim Char As String, wPart As String For i = 1 To Len(Str) Char = Mid(Str, i, 1) If Char = "*" Then StrList.Add wPart: wPart = "" Else wPart = wPart & Char End If Next i If Len(wPart) > 0 Then StrList.Add wPart End Function 

Удачи!

@Alex P, теперь .find НЕ эффективнее, например:

 Option Explicit Option Compare Text Sub SearchClientRecord() With Application .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim Search As String Dim Finalrow As Long Dim SearchFinalRow As Long Dim i&, j& Dim scs As Worksheet Dim scd As Worksheet Dim DATA() As Variant Dim Range_to_Copy As Range Set scs = Sheets("Client Search") Set scd = Sheets("Client Database") With scd Finalrow = .Range("D100000").End(xlUp).Row DATA = .Range(.Cells(19, 3), .Cells(Finalrow, 19)).Value2 End With With scs .Range("C19:S1018").ClearContents Search = .Range("C12").Value SearchFinalRow = .Range("D100000").End(xlUp).Row End With With scd For j = 3 To 19 For i = 19 To Finalrow If InStr(DATA(i, j), Search) > 0 Then 'If scd.Cells(i, j) Like "*" & Search & "*" Then If Not Range_to_Copy Is Nothing Then Set Range_to_Copy = Union(Range_to_Copy, .Range(.Cells(i, 3), .Cells(i, 19))) 'scd.Range(scd.Cells(i, 3), scd.Cells(i, 19)).Copy 'scs.Range("C100000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats Else Set Range_to_Copy = .Range(.Cells(i, 3), .Cells(i, 19)) End If End If Next i Next j End With 'scd Erase DATA With scs Range_to_Copy.Copy _ Destination:=.Range("C100000").End(xlUp).Offset(1, 0) '.PasteSpecial xlPasteFormulasAndNumberFormats .Range("C19:S1018").Select 'this line might be superflous .Range("$C$18:$S$1009").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes End With Call Border Columns("C:S").HorizontalAlignment = xlCenter 'on wich worksheet ?? Set Range_to_Copy = Nothing Set scs = Nothing Set scd = Nothing With Application .EnableEvents = True .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub 
  • Ссылка на командные кнопки, добавленные во время выполнения с VBA в Excel
  • Сравнение значений времени в VBA бросает ошибку времени выполнения 13 'несоответствие типа'
  • Ошибка 438 времени выполнения Excel на некоторой рабочей станции
  • Java - запуск Excel с использованием runtime.getRuntime (). Exec
  • Ошибка времени выполнения VBA 1004 - Недопустимый диапазон объекта_Global - IF Formula
  • Excel VBA уменьшает время выполнения
  • Вторая половина макроса VBA выполняется в 3 раза быстрее, если я не запускаю первую часть до
  • Проблемы с несколькими ошибками Runtime: обновленный код - все еще возникают проблемы
  • Извлечение строки с использованием MID: VBA RunTime Error 424: Object Required
  • Объяснение - Копирование данных кода VBA с помощью PasteSpecial
  • Код Excel VBA: ошибка компиляции в версии x64 (требуется атрибут «PtrSafe»)
  • Interesting Posts
    Давайте будем гением компьютера.