Fsociety_, здравствуйте. Сначала протестируйте на своих данных и сообщите результаты.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Добрый день, протестировал немного вчера Ваш код, все отлично, немного переделал под свои нужды.
Только один вопрос: К примеру если я захочу добавить какую то формулу для обработки, то как мне это сделать правильно? Могли бы чуть подробнее описать? Просто я пока с такими вещами еще не работал. Я видел вы скинули два справочника, но как правильно мне нужно будет записывать нужные функции в код?
Fsociety_, здравствуйте! Встречайте обновлённую версию Теперь всё ещё быстрее, а функцию надо просто ВЫБРАТЬ даблкликом из списка, а не вводить. Из формы можно выйти, нажав Esc или классически - по крестику
Цитата
Fsociety_: если я захочу добавить какую то формулу для обработки, то как мне это сделать правильно?
1. добавляем текст для вызова в FFF_arrFuncNames 2. Расписываем в MyFunc, что должно произойти, если выбран новый текст Для примера сделал очистку не обязательной, вынеся её в отдельную функцию - теперь функций 5
Модуль
Код
Option Explicit
'====================================================================================================
Public FFF_funcName$ ' публичная переменная для возврата имени выбранной функции из формы
'====================================================================================================
Public Property Get FFF_arrFuncNames() ' сюда добавляем текстовые вызовы функций
FFF_arrFuncNames = Array("ОЧИСТИТЬ", "ПЕРЕВЕРНУТЬ", "ПРОПИСН", "ПРОПНАЧ", "СТРОЧН")
End Property
'----------------------------------------------------------------------------------------------------
Private Function MyFunc(ByVal valChange) ' эта функция выбирает действие, в зависимости от выбранного текстового вызова
' тут расписываем действия для КАЖДОГО вызова (в моём примере — по индексам массива от 0 до (КОЛ-ВО вариантов-1))
If FFF_funcName = FFF_arrFuncNames(0) Then ' Если была выбрана команда "ОЧИСТИТЬ". Можно ещё вот так: «If FFF_funcName = "ОЧИСТИТЬ" Then»
valChange = Replace$(valChange, Chr(160), Chr(32))
valChange = Application.Clean(valChange)
MyFunc = Application.Trim(valChange)
Exit Function
End If
If FFF_funcName = FFF_arrFuncNames(1) Then MyFunc = StrReverse(valChange): Exit Function
If FFF_funcName = FFF_arrFuncNames(2) Then MyFunc = UCase(valChange): Exit Function
If FFF_funcName = FFF_arrFuncNames(3) Then MyFunc = StrConv(valChange, vbProperCase): Exit Function
If FFF_funcName = FFF_arrFuncNames(4) Then MyFunc = LCase(valChange)
End Function
'====================================================================================================
Sub MyFuncInSelection()
Dim arr, rng As Range, ar As Range, r&, c&, t!
Set rng = Selection ' запоминаем выделенный диапазон в переменную, чтобы случайно не сбросился шаловливыми ручонками
FuncChoose.Show ' вызываем форму для получения текстового вызова функции
If Len(FFF_funcName) = 0 Then Exit Sub ' если пользователь ничего не выбрал, то выходим
t = Timer ' включаем таймер для замера времены выполнения
Application.ScreenUpdating = False ' отключаем обновление экрана для ускорения макроса и во имя избегания визуальных неприглядностей (мерцания)
' цикл по выделенному с применением нужных манипуляций
For Each ar In rng.Areas
If ar.Count = 1 Then
ar.Value2 = MyFunc(ar.Value2)
Else
arr = ar.Value2
For c = 1 To UBound(arr, 2)
For r = 1 To UBound(arr, 1)
arr(r, c) = MyFunc(arr(r, c))
Next r
Next c
ar.Value2 = arr
End If
Next ar
Application.ScreenUpdating = True ' включаем обновление экрана обратно
MsgBox "Выбрана функция: " & FFF_funcName & vbLf & _
"Ячеек обработано: " & rng.Count & vbLf & vbLf & _
"Время работы макроса: " & Format$(Timer - t, "0.00 сек"), vbInformation, "ГОТОВО"
End Sub
'====================================================================================================
Форма
Код
Option Explicit
'====================================================================================================
Private Sub UserForm_Initialize()
FFF_funcName = "" ' очищаем публичную переменную с именем функции
lb.List = FFF_arrFuncNames ' наполняем список листбокса (окна выбора) из публичного массива
End Sub
'====================================================================================================
Private Sub lb_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FFF_funcName = lb.List(lb.ListIndex) ' если был даблклик, то назначаем выбранное значение публичной переменной и выходим
Unload Me
End Sub
'====================================================================================================
Private Sub lb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me ' если был нажат Esc, то выходим
End Sub
'====================================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄