Зависает excel при копировании, в дебаге направляет на функцию: [vba]
Код
Public Function заголовоктекста(WRng As Variant, AddRng As Range, Limit As Integer, Optional Chr As String = "", Optional Bln As Boolean = True)
Application.Volatile True If Len(WRng) > Limit Then Select Case Bln = False Case True заголовоктекста = WRng Case False заголовоктекста = "-" End Select Else End If
For Each x In AddRng If Len(WRng & Chr & x) <= Limit Then заголовоктекста = WRng & Chr & x Exit Function Else End If Next x
End Function
[/vba]
Как только удаляю эту функцию, перенаправляет на
[vba]
Код
Function ПереносСлов(Rng1 As Variant, lim1 As Integer)
On Error Resume Next Application.Volatile True
Dim tt As String Dim t As String Dim t0 As String Dim i As Integer
t = "" tt = Trim(CStr(Rng1))
If Len(tt) < lim1 Then ПереносСлов = tt Exit Function Else End If
arr1 = VBA.Split(tt)
For i = LBound(arr1) To UBound(arr1) t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0 Exit Function Else End If Next i
End Function
[/vba]
Знатоки, подскажите пожалуйста, в чем проблема?
Без этих функций всё работает корректно, но они нужны
Зависает excel при копировании, в дебаге направляет на функцию: [vba]
Код
Public Function заголовоктекста(WRng As Variant, AddRng As Range, Limit As Integer, Optional Chr As String = "", Optional Bln As Boolean = True)
Application.Volatile True If Len(WRng) > Limit Then Select Case Bln = False Case True заголовоктекста = WRng Case False заголовоктекста = "-" End Select Else End If
For Each x In AddRng If Len(WRng & Chr & x) <= Limit Then заголовоктекста = WRng & Chr & x Exit Function Else End If Next x
End Function
[/vba]
Как только удаляю эту функцию, перенаправляет на
[vba]
Код
Function ПереносСлов(Rng1 As Variant, lim1 As Integer)
On Error Resume Next Application.Volatile True
Dim tt As String Dim t As String Dim t0 As String Dim i As Integer
t = "" tt = Trim(CStr(Rng1))
If Len(tt) < lim1 Then ПереносСлов = tt Exit Function Else End If
arr1 = VBA.Split(tt)
For i = LBound(arr1) To UBound(arr1) t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0 Exit Function Else End If Next i
End Function
[/vba]
Знатоки, подскажите пожалуйста, в чем проблема?
Без этих функций всё работает корректно, но они нужныrexar
Сообщение отредактировал rexar - Пятница, 02.12.2016, 18:19
Ну вы бы хоть указали, на какой строке вылетает и что при этом говорит дебаггер. Но, не вдаваясь в суть Ваших макросов, чаще всего причиной подвисания является массовый пересчёт ячеек листов. Чтобы избежать тормозов и подвисаний в самом начале процедуры отключите всё, что может тормозить: обновление экрана, вывод сообщений, обработка событий !!!, пересчёт листа !!! [vba]
Код
With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With
[/vba] а по окончании - включите всё обратно: [vba]
Код
With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With
[/vba] [offtop]У меня эти "волшебные слова", так же как и некоторые другие часто употребляемые выражения добавлены в список автозамены Punto Switcher'a и им назначены короткие аббревиатуры. Например, введённое app-true заменяется на With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With app-false - на With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With deb-pr - на Debug.Print mbx - на MsgBox и т.п. ОЧЕНЬ УДОБНО! РЕКОМЕНДУЮ.[/offtop]
Ну вы бы хоть указали, на какой строке вылетает и что при этом говорит дебаггер. Но, не вдаваясь в суть Ваших макросов, чаще всего причиной подвисания является массовый пересчёт ячеек листов. Чтобы избежать тормозов и подвисаний в самом начале процедуры отключите всё, что может тормозить: обновление экрана, вывод сообщений, обработка событий !!!, пересчёт листа !!! [vba]
Код
With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With
[/vba] а по окончании - включите всё обратно: [vba]
Код
With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With
[/vba] [offtop]У меня эти "волшебные слова", так же как и некоторые другие часто употребляемые выражения добавлены в список автозамены Punto Switcher'a и им назначены короткие аббревиатуры. Например, введённое app-true заменяется на With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With app-false - на With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With deb-pr - на Debug.Print mbx - на MsgBox и т.п. ОЧЕНЬ УДОБНО! РЕКОМЕНДУЮ.[/offtop]Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 02.12.2016, 22:46
Опять же не пытаясь догадаться, какие аргументы Вы сообщаете функциям и какие результаты ожидаете получить, а только рассматривая код и размерности переменных, можно сказать, что: 1. Зачем у Вас везде ставится Application.Volatile True ? Это скорее всего не обязательно, а работу тормозит сильно. 2. Функция ЗаголовокТекста в принципе может подтормаживать из-за прямого обращения к ячейкам листа в цикле. Функция ПереносСлов вообще работает только с переданными ей аргументами и не должна тормозить. 3. Ну и с If...Then/Else/End If с Select Case Вы что-то, похоже, перемудрили. Попробуйте так:
[vba]
Код
Public Function ЗаголовокТекста(WRng As Variant, AddRng As Range, Limit As Integer, Optional Chr As String = "", Optional Bln As Boolean = True) With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With If Len(WRng) > Limit Then ЗаголовокТекста = IIf(Bln, "-", WRng) For Each x In AddRng If Len(WRng & Chr & x) <= Limit Then ЗаголовокТекста = WRng & Chr & x: Exit For End If Next x With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With End Function
Function ПереносСлов(Rng1 As Variant, lim1 As Integer) On Error Resume Next 'Application.Volatile True Dim tt As String, t As String, t0 As String, i As Integer 't = "" tt = Trim(CStr(Rng1)) If Len(tt) < lim1 Then ПереносСлов = tt: Exit Function End If arr1 = Split(tt) For i = LBound(arr1) To UBound(arr1) t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0: Exit Function End If Next i End Function
[/vba]
И главный совет: Опция Option Explicit очень полезная штука, помогающая легко отловить ошибки. ОБЪЯВЛЯЙТЕ ВСЕ ПЕРЕМЕННЫЕ!
Опять же не пытаясь догадаться, какие аргументы Вы сообщаете функциям и какие результаты ожидаете получить, а только рассматривая код и размерности переменных, можно сказать, что: 1. Зачем у Вас везде ставится Application.Volatile True ? Это скорее всего не обязательно, а работу тормозит сильно. 2. Функция ЗаголовокТекста в принципе может подтормаживать из-за прямого обращения к ячейкам листа в цикле. Функция ПереносСлов вообще работает только с переданными ей аргументами и не должна тормозить. 3. Ну и с If...Then/Else/End If с Select Case Вы что-то, похоже, перемудрили. Попробуйте так:
[vba]
Код
Public Function ЗаголовокТекста(WRng As Variant, AddRng As Range, Limit As Integer, Optional Chr As String = "", Optional Bln As Boolean = True) With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: .Calculation = xlManual: End With If Len(WRng) > Limit Then ЗаголовокТекста = IIf(Bln, "-", WRng) For Each x In AddRng If Len(WRng & Chr & x) <= Limit Then ЗаголовокТекста = WRng & Chr & x: Exit For End If Next x With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlAutomatic: End With End Function
Function ПереносСлов(Rng1 As Variant, lim1 As Integer) On Error Resume Next 'Application.Volatile True Dim tt As String, t As String, t0 As String, i As Integer 't = "" tt = Trim(CStr(Rng1)) If Len(tt) < lim1 Then ПереносСлов = tt: Exit Function End If arr1 = Split(tt) For i = LBound(arr1) To UBound(arr1) t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0: Exit Function End If Next i End Function
[/vba]
И главный совет: Опция Option Explicit очень полезная штука, помогающая легко отловить ошибки. ОБЪЯВЛЯЙТЕ ВСЕ ПЕРЕМЕННЫЕ!Alex_ST
Василич, подправь в посте автора первой цитаты, пожалуйста. Я такого не писАл rexar, к стати, посмотрел повнимательнее на ПереносСлов чтобы выяснить корректность применения On Error Resume Next и понял, что кдинственное (кажется) возможное место возникновения ошибки - это команда arr1 = Split(tt), которая выдаст ошибку если в tt нет ни одного пробела. Ну так это решается намного проще: делайте arr1 = Split(tt), а потом цикл по всем этементам массива кроме последнего.
[vba]
Код
Function ПереносСлов(Rng1 As Variant, lim1 As Integer) Dim tt As String, t As String, t0 As String, i As Integer tt = Trim(CStr(Rng1)) If Len(tt) < lim1 Then ПереносСлов = tt: Exit Function End If arr1 = Split(tt & " ") For i = LBound(arr1) To UBound(arr1) - 1 t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0: Exit Function End If Next i End Function
[/vba]
Василич, подправь в посте автора первой цитаты, пожалуйста. Я такого не писАл rexar, к стати, посмотрел повнимательнее на ПереносСлов чтобы выяснить корректность применения On Error Resume Next и понял, что кдинственное (кажется) возможное место возникновения ошибки - это команда arr1 = Split(tt), которая выдаст ошибку если в tt нет ни одного пробела. Ну так это решается намного проще: делайте arr1 = Split(tt), а потом цикл по всем этементам массива кроме последнего.
[vba]
Код
Function ПереносСлов(Rng1 As Variant, lim1 As Integer) Dim tt As String, t As String, t0 As String, i As Integer tt = Trim(CStr(Rng1)) If Len(tt) < lim1 Then ПереносСлов = tt: Exit Function End If arr1 = Split(tt & " ") For i = LBound(arr1) To UBound(arr1) - 1 t0 = t t = t & " " & arr1(i) t = Trim(t) If Len(t) > lim1 Then ПереносСлов = t0: Exit Function End If Next i End Function
И ещё: появилось у меня подозрение, что Split'ом и последующим Trim'ом в цикле по элементам массива Вы убираете задвоенные пробелы в середине стринга. Так для этого же есть функция листа СЖПРОБЕЛЫ, которая удаляет не только пробелы в начале и конце стринга аргумента, но и все многократные пробелы в середине заменяет на одинарные. Из VBA при необходимости её можно использовать, например, так [vba]
Код
sText = Application.WorksheetFunction.Trim(sText)
[/vba]или в сокращённой записи (но у некоторых почему-то иногда ругается) [vba]
Код
sText = Application.Trim(sText)
[/vba]Я, например, уже давным-давно у себя на панели сделал специальную кнопку для вызова такого макроса очистки выделенного диапазона от плодов трудов "специалистов", выравнивающих тексты в ячейках пробелами:
[vba]
Код
Sub Trim_By_Formula() ' применить функцию СЖПРОБЕЛЫ к видимым ячейкам выделенного диапазона Dim rRng As Range, rArea As Range Set rRng = Intersect(ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)) If Not rRng Is Nothing Then Application.ScreenUpdating = False: Application.EnableEvents = False With rRng .Replace Chr(160), " ", xlPart ' Chr(160) - неразрывный пробел For Each rArea In .Areas rArea.Value = Application.Trim(rArea) ' СЖПРОБЕЛЫ Next .Replace " " & Chr(10), Chr(10), xlPart ' пробел перед LF .Replace Chr(10) & " ", Chr(10), xlPart ' пробел после LF .Select End With Application.ScreenUpdating = True: Application.EnableEvents = True End If End Sub
[/vba]
P.S. Select в конце процедуры, конечно не обязателен, но и стоит не просто так, а чтобы по окончании обработки были видны обработанные макросом ячейки
И ещё: появилось у меня подозрение, что Split'ом и последующим Trim'ом в цикле по элементам массива Вы убираете задвоенные пробелы в середине стринга. Так для этого же есть функция листа СЖПРОБЕЛЫ, которая удаляет не только пробелы в начале и конце стринга аргумента, но и все многократные пробелы в середине заменяет на одинарные. Из VBA при необходимости её можно использовать, например, так [vba]
Код
sText = Application.WorksheetFunction.Trim(sText)
[/vba]или в сокращённой записи (но у некоторых почему-то иногда ругается) [vba]
Код
sText = Application.Trim(sText)
[/vba]Я, например, уже давным-давно у себя на панели сделал специальную кнопку для вызова такого макроса очистки выделенного диапазона от плодов трудов "специалистов", выравнивающих тексты в ячейках пробелами:
[vba]
Код
Sub Trim_By_Formula() ' применить функцию СЖПРОБЕЛЫ к видимым ячейкам выделенного диапазона Dim rRng As Range, rArea As Range Set rRng = Intersect(ActiveWindow.RangeSelection.SpecialCells(xlCellTypeVisible), ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)) If Not rRng Is Nothing Then Application.ScreenUpdating = False: Application.EnableEvents = False With rRng .Replace Chr(160), " ", xlPart ' Chr(160) - неразрывный пробел For Each rArea In .Areas rArea.Value = Application.Trim(rArea) ' СЖПРОБЕЛЫ Next .Replace " " & Chr(10), Chr(10), xlPart ' пробел перед LF .Replace Chr(10) & " ", Chr(10), xlPart ' пробел после LF .Select End With Application.ScreenUpdating = True: Application.EnableEvents = True End If End Sub
[/vba]
P.S. Select в конце процедуры, конечно не обязателен, но и стоит не просто так, а чтобы по окончании обработки были видны обработанные макросом ячейкиAlex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Суббота, 03.12.2016, 20:28
Не понимаю, может это у меня что с excel, потому, что удалил все функции, которые писал выше, всё нормально, через некоторое время при копировании ячейки та же проблема, но направляем уже на простейшую функцию...
Не понимаю, может это у меня что с excel, потому, что удалил все функции, которые писал выше, всё нормально, через некоторое время при копировании ячейки та же проблема, но направляем уже на простейшую функцию...rexar
а вот это уже бывало... При этом вылетать может на простейших стандартных встроенных функциях VB Кажется проблемы были в референсах. Проверьте, нет ли битых ссылок на библиотеки в Tools-References
а вот это уже бывало... При этом вылетать может на простейших стандартных встроенных функциях VB Кажется проблемы были в референсах. Проверьте, нет ли битых ссылок на библиотеки в Tools-ReferencesAlex_ST
Что копирует? Куда копирует? Никакого копирования в рассматривавшихся функциях нет! Вообще не понятно, в составе какого проекта Вы их хотите использовать и какие операции производятся перед вызовом функций. В процедурах рассматривавшихся здесь функций никаких тонкостей, которые могут вызвать зависание, нет. Но Вы, похоже, работаете без Option Explicit, поэтому вполне возможно, что происходит пересечение переменных с другими, объявленными в проекте. ------------------------------------------------ Вы сначала пишете
но при этом абсолютно не поясняете, с использованием каких процедур? Ваших, выложенных в первом посте или одним из нескольких вариантов, исправленных мною? А потом:
Блин, я не понимаю, у Вас таки-заработало нормально или нет?
Что копирует? Куда копирует? Никакого копирования в рассматривавшихся функциях нет! Вообще не понятно, в составе какого проекта Вы их хотите использовать и какие операции производятся перед вызовом функций. В процедурах рассматривавшихся здесь функций никаких тонкостей, которые могут вызвать зависание, нет. Но Вы, похоже, работаете без Option Explicit, поэтому вполне возможно, что происходит пересечение переменных с другими, объявленными в проекте. ------------------------------------------------ Вы сначала пишете
но при этом абсолютно не поясняете, с использованием каких процедур? Ваших, выложенных в первом посте или одним из нескольких вариантов, исправленных мною? А потом:
Alex_ST, удалил функцию заголовок и проверил на битые ссылки, сохранил в новом формате и всё, вроде сейчас всё работает. Огромное спасибо! удачи Вам в изучении excel и vba
Alex_ST, удалил функцию заголовок и проверил на битые ссылки, сохранил в новом формате и всё, вроде сейчас всё работает. Огромное спасибо! удачи Вам в изучении excel и vba rexar
rexar, штатной гадалки сейчас на форуме нет. А т.к. Вы упорно не отвечаете, какими из выложенных в топике процедур пользуетесь и для чего, то угадать почему и на чём зависает некому.
rexar, штатной гадалки сейчас на форуме нет. А т.к. Вы упорно не отвечаете, какими из выложенных в топике процедур пользуетесь и для чего, то угадать почему и на чём зависает некому.Alex_ST