полностью согласен Под "глупо" я имел ввиду, что метод известен человеку, но, несмотря на это, придумывается велосипед
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
БМВ: один из аргументов процедуры может содержать код ответа
результат функции - просто дополнительная информация. Можно её сделать Long и проверять различные результаты возможной работы. Глупо делать процедуру с переменной, в которую может вернуться значение (дополнительное ограничение на переменную: она должна передаваться только ссылкой) вместо того, чтобы сделать функцию, которая этот результат будет просто возвращать, в случае чего. Но как дополнительный вариант для понимания - конечно пойдёт
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
alexpet, здравствуйте Просто завершить все процедуры можно с помощью оператора End, однако, если вы что-то меняли в работе Excel, то это так и останется. К тому же не будет нормального сообщения для пользователя. Чтобы сделать хорошо, я использую булевые функции вместо процедур и просто проверяю возвращаемое значение. Если False, то выхожу, т.к. внутри функции что-то пошло не так и она уже вывела сообщение для пользователя.
Пример
Код
Option Explicit
'==================================================================================================
Sub Main()
Dim AC&
AC = Application.Calculation: Application.Calculation = xlCalculationManual
If Not func1(Selection) Then GoTo ex
If Not func2(15) Then GoTo ex
ex: Application.Calculation = AC
End Sub
'==================================================================================================
Function func1(rng As Range) As Boolean
If rng.Count = 1 Then MsgBox "Нельзя одну ячейку!", vbCritical, "func1": Exit Function
' ... остальной код и сколько угодно проверок
func1 = True
End Function
'==================================================================================================
Function func2(n&) As Boolean
If n < 0 Then MsgBox "Нельзя меньше нуля!", vbCritical, "func2": Exit Function
' ... остальной код и сколько угодно проверок
func2 = True
End Function
'==================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ігор Гончаренко, ну ошибся, человек — понятно же, что он хочет Прокрутка, всё-таки, вертикальная, т.к. происходит вдоль вертикали (сверху/вниз). Я и сам раньше путался, пока вот так не запомнил (вдоль какой оси)…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
встречный вопрос: а зачем скроллить, если можно этого не делать. Зачем тратить время и/или мотать экран попусту? В чём смысл?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
tchack: надо чтобы команда переносила на строку 100, не двигая таблицу по горизонтали
можно переходить на столбцы ЛЕВЕЕ, чтобы нужная ячейка была ПРАВЕЕ. Но я проблемы в этом не вижу, конечно…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Сергей Верухин, пожалуйста Спрашивайте, если что непонятно будет
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
'Option Base 1
Option Explicit
'Option Private Module
'==================================================================================================
Sub Splitter()
Dim rng As Range
Dim x, arr, aCrit(), aOne(1 To 1, 1 To 1)
Dim tx$, t!, r&, m&, nSpl&, f As Boolean
t = Timer
Set rng = [a2:a88]: arr = rng.Value2
ReDim Preserve arr(1 To UBound(arr, 1), 1 To 2)
aCrit = Array("шумоглушитель *", "гибкая вставка *", "вентилятор канальный *", "обратный клапан *", "регулятор скорости *")
For r = 1 To UBound(arr, 1)
tx = LCase$(Trim(arr(r, 1)))
For Each x In aCrit
If tx Like x Then f = True: Exit For
Next x
If f Then
f = False: nSpl = nSpl + 1: m = Len(x)
arr(r, 2) = Trim(Mid$(arr(r, 1), m)): arr(r, 1) = Trim(Left$(arr(r, 1), m - 2))
End If
Next r
If nSpl = 0 Then MsgBox "Строк для разделения НЕ НАЙДЕНО!", vbExclamation, "Время работы: " & Format$(Timer - t, "0.00 сек"): Exit Sub
rng.Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
MsgBox "Разделено строк: " & Format$(nSpl, "#,##0") & " из " & UBound(arr, 1), vbInformation, "Время работы: " & Format$(Timer - t, "0.00 сек")
End Sub
'==================================================================================================
'==================================================================================================
даблклик по А1 запускает макрос, по С1 — переносит данные из третьего столбца в первый (чтобы повторить)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Сергей Верухин, создайте отдельную тему для разбора разделения строки по ячейкам
Возможно, этого примера хватит
Код
Sub t()
Dim x, aMask()
aMask = Array("*приточная*", "*вытяжная*", "*установка*", "*id*")
For Each x In aMask
Debug.Print LCase$("автоматическая Установка на работе") Like x
Next x
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
я не тестировал, но, думаю, что ваш вариант вполне корректно отработал по предложенным вариантам. Но только по ним. Если будут другие пары замен, то толку от него не будет, если я правильно понял. Именно это я и сказал учесть. То есть у вас само правило сложнее (у вас даже числовые суффиксы отдельно вынесены) — его также можно дополнять и расширять, но гораздо сложнее чем замена "в лоб". Кода меньше, работает также по скорости, но в понимании и адаптации - сложнее.
Я же показал сам принцип - его можно использовать при любых данных.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Сергей Верухин, учтите ещё разницу подходов у нас с Ігорем Гончаренко: у меня адаптация "в лоб", то есть ровно то, что вы делаете, теми же способами и методами — я показал, как написать короче и/или ускорить работу.
Ігор Гончаренко же вывел закономерность, правило формирования замен и, поэтому, всё, что под правило не попадёт — не будет заменено или будет заменено некорректно. Учтите это и успехов в VBA
P.S.: Парные замены можно написать короче, но, едва ли это будет понятнее
Код
Dim i&
arr = Array("было1", "стало1", "было2", "стало2")
For i = LBound(arr) To UBound(arr) Step 2
Cells.Replace What:=arr(i), Replacement:=arr(i + 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Сергей Верухин: Единственный минус - большое количество позиций для изменения, долго набивал все в Excel
ну а кто будет формировать список замен, если не вы? Можно на листе написать в 2ух столбцах было-стало и сразу в код получить перечень. Но писать-то надо))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ігор Гончаренко: но тоже есть момент - компьютер должен быть включен, Windows должен работать
Компьютер должен существовать
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Симонова Екатерина, здравствуйте Создал свою надстройку более 5ти лет назад и ни разу не прикасался к Ленте: макросы из надстройки собраны в 4 пользовательские формы с вкладками и кнопками для них - для каждого макроса. Макросы вызова каждой формы выведены на Панель Быстрого Доступа в виде кнопок (4 шт.) и доступны в любом файле. Может, и вам не стоит заморачиваться…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Увеличить количество последних документов в панели виндовс 10, После установки MS Office 2021 LTSC уменьшилось и больше не увеличивается количество последних документов (при нажатии на значек екселя в панели).
Msi2102, вот зачем ты портишь такую статистику вредных помогающих? Кто за язык пальцы тянул?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Увеличить количество последних документов в панели виндовс 10, После установки MS Office 2021 LTSC уменьшилось и больше не увеличивается количество последних документов (при нажатии на значек екселя в панели).
Айдар: И как эти сообщения помогают увеличить количество последних документов в панели виндовс?
Вам не обязаны отвечать только по теме и запросто могут реагировать на любое ваше сообщение. Пока вы вызвали желание отреагировать только на ваш обиженный пост, судя по всему…
И вообще — почему вы ещё здесь? Почему не "ищите удачи на других ресурсах"?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄