Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Заменить Function на Sub - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заменить Function на Sub (Макросы/Sub)
Заменить Function на Sub
baaur Дата: Вторник, 20.10.2015, 09:30 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день, всем
Уважаемые знатоки, не могли бы вы подсказать как можно переделать или заменить в Function что бы работала только на определенную ячейку как Sub.
То есть файлы и нужно что бы макрос после нажатия кнопки срабатывал только на одну ячейку. D7 например.
К сообщению приложен файл: 2137736.xls (31.0 Kb)
 
Ответить
СообщениеДобрый день, всем
Уважаемые знатоки, не могли бы вы подсказать как можно переделать или заменить в Function что бы работала только на определенную ячейку как Sub.
То есть файлы и нужно что бы макрос после нажатия кнопки срабатывал только на одну ячейку. D7 например.

Автор - baaur
Дата добавления - 20.10.2015 в 09:30
SLAVICK Дата: Вторник, 20.10.2015, 09:39 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Не понимаю зачем такое нужно, но вот например так:

В какую бы Вы ячейку не прописали эту функцию - она будет возвращать транслит только для активного листа - ячейки [d9].
Можно прописать вообще жесткую привязку к листу и ячейке, тогда так:
[vba]
Код
txt = ThisWorkbook.Sheets("Лист1").[d9]
[/vba]
К сообщению приложен файл: 8475134.xls (37.5 Kb)


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Вторник, 20.10.2015, 09:45
 
Ответить
СообщениеНе понимаю зачем такое нужно, но вот например так:

В какую бы Вы ячейку не прописали эту функцию - она будет возвращать транслит только для активного листа - ячейки [d9].
Можно прописать вообще жесткую привязку к листу и ячейке, тогда так:
[vba]
Код
txt = ThisWorkbook.Sheets("Лист1").[d9]
[/vba]

Автор - SLAVICK
Дата добавления - 20.10.2015 в 09:39
Roman777 Дата: Вторник, 20.10.2015, 09:47 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Можно просто в отдельной процедуре Sub использовать данную функцию для определённой ячейки.
[vba]
Код
Function Translit(txt As String) As String ' с учётом регистра символов
txtRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "y", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "tch", _
"sh", "sch", "", "y", "", "e", "yu", "ya")
For iCount% = 1 To 33
txt$ = Replace(txt$, Mid(txtRussian$, iCount%, 1), arrTranslit(iCount%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), UCase(arrTranslit(iCount%)), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function

Sub Transclited()
Cells(1, 1) = Translit(Cells(1, 1))
End Sub
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 20.10.2015, 09:51
 
Ответить
СообщениеМожно просто в отдельной процедуре Sub использовать данную функцию для определённой ячейки.
[vba]
Код
Function Translit(txt As String) As String ' с учётом регистра символов
txtRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "y", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "tch", _
"sh", "sch", "", "y", "", "e", "yu", "ya")
For iCount% = 1 To 33
txt$ = Replace(txt$, Mid(txtRussian$, iCount%, 1), arrTranslit(iCount%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), UCase(arrTranslit(iCount%)), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function

Sub Transclited()
Cells(1, 1) = Translit(Cells(1, 1))
End Sub
[/vba]

Автор - Roman777
Дата добавления - 20.10.2015 в 09:47
baaur Дата: Вторник, 20.10.2015, 09:48 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день, SLAVICK,
спасибо за ответ, только почему то не работает
я имел ввиду что будет Sub, и вывести кнопку что бы макрос менял автоматом только данные в одной ячейке.
 
Ответить
СообщениеДобрый день, SLAVICK,
спасибо за ответ, только почему то не работает
я имел ввиду что будет Sub, и вывести кнопку что бы макрос менял автоматом только данные в одной ячейке.

Автор - baaur
Дата добавления - 20.10.2015 в 09:48
baaur Дата: Вторник, 20.10.2015, 09:49 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Roman777, то есть как?
простите я не знаю.
 
Ответить
СообщениеRoman777, то есть как?
простите я не знаю.

Автор - baaur
Дата добавления - 20.10.2015 в 09:49
Roman777 Дата: Вторник, 20.10.2015, 09:52 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
baaur, добавил в тот же модуль ниже процедуру в сообщении №3 видно:
[vba]
Код
Sub Transclited()
Cells(1, 1) = Translit(Cells(1, 1))
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
Сообщениеbaaur, добавил в тот же модуль ниже процедуру в сообщении №3 видно:
[vba]
Код
Sub Transclited()
Cells(1, 1) = Translit(Cells(1, 1))
End Sub
[/vba]

Автор - Roman777
Дата добавления - 20.10.2015 в 09:52
baaur Дата: Вторник, 20.10.2015, 09:52 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Roman777, Спасибо большое!!!
получилось
 
Ответить
СообщениеRoman777, Спасибо большое!!!
получилось

Автор - baaur
Дата добавления - 20.10.2015 в 09:52
SLAVICK Дата: Вторник, 20.10.2015, 09:54 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Ну тогда просто добавить простенький макрос:

ОЙ - меня опередили :D
К сообщению приложен файл: 2137736-1-.xls (33.0 Kb)


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Вторник, 20.10.2015, 09:56
 
Ответить
СообщениеНу тогда просто добавить простенький макрос:

ОЙ - меня опередили :D

Автор - SLAVICK
Дата добавления - 20.10.2015 в 09:54
baaur Дата: Вторник, 20.10.2015, 09:57 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, спасбо большое!!!
Так же работает.
 
Ответить
СообщениеSLAVICK, спасбо большое!!!
Так же работает.

Автор - baaur
Дата добавления - 20.10.2015 в 09:57
baaur Дата: Вторник, 20.10.2015, 09:59 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Уважаемые,
а можно вопрос,
в этом макросе он не совсем корректно переделывает некоторые имена/фамилии
Например Юлия он прописывает как YUliya можно ли как нибудь это исправить?
 
Ответить
СообщениеУважаемые,
а можно вопрос,
в этом макросе он не совсем корректно переделывает некоторые имена/фамилии
Например Юлия он прописывает как YUliya можно ли как нибудь это исправить?

Автор - baaur
Дата добавления - 20.10.2015 в 09:59
baaur Дата: Вторник, 20.10.2015, 10:01 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Или просто макрос не может это корректно прописывать?
 
Ответить
СообщениеИли просто макрос не может это корректно прописывать?

Автор - baaur
Дата добавления - 20.10.2015 в 10:01
SLAVICK Дата: Вторник, 20.10.2015, 10:03 | Сообщение № 12
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Макрос здесь ни при чем - это баг функции - нужно ее подкорректировать. Сейчас посмотрю ;)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеМакрос здесь ни при чем - это баг функции - нужно ее подкорректировать. Сейчас посмотрю ;)

Автор - SLAVICK
Дата добавления - 20.10.2015 в 10:03
SLAVICK Дата: Вторник, 20.10.2015, 10:15 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Ну вот: :D
[vba]
Код
Sub testMe()
Dim txt$
txt = Translit(CStr([d7])): [d7] = txt
End Sub
Function Translit(txt As String) As String ' с учётом регистра символов
txtRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "y", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "tch", _
"sh", "sch", "", "y", "", "e", "yu", "ya")
For iCount% = 1 To 33
txt$ = Replace(txt$, Mid(txtRussian$, iCount%, 1), arrTranslit(iCount%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), StrConv(arrTranslit(iCount%), 3), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function
[/vba]
К сообщению приложен файл: 5376643.xls (33.5 Kb)


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Вторник, 20.10.2015, 10:16
 
Ответить
СообщениеНу вот: :D
[vba]
Код
Sub testMe()
Dim txt$
txt = Translit(CStr([d7])): [d7] = txt
End Sub
Function Translit(txt As String) As String ' с учётом регистра символов
txtRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "y", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "tch", _
"sh", "sch", "", "y", "", "e", "yu", "ya")
For iCount% = 1 To 33
txt$ = Replace(txt$, Mid(txtRussian$, iCount%, 1), arrTranslit(iCount%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), StrConv(arrTranslit(iCount%), 3), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function
[/vba]

Автор - SLAVICK
Дата добавления - 20.10.2015 в 10:15
baaur Дата: Вторник, 20.10.2015, 10:29 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, Превосходно, Благодарю!!!
 
Ответить
СообщениеSLAVICK, Превосходно, Благодарю!!!

Автор - baaur
Дата добавления - 20.10.2015 в 10:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Заменить Function на Sub (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!