Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
ФИО в инициалы макросом, ФИО (отчества может не быть) преобразовать в инициалы макросом
 
#1
17.06.2017 19:02:28

Здравствуйте!

Очень часто приходится иметь дело с преобразованием Фамилий Имен и Отчеств в Фамилию и инициалы. Использую следующую формулу:

ЛЕВСИМВ(A2;НАЙТИ(СИМВОЛ(32);A2))&ЕСЛИ(ДЛСТР(A2)-ДЛСТР(ПОДСТАВИТЬ(A2;СИМВОЛ(32);""))=1;ПСТР(A2;НАЙТИ(СИМВОЛ(32);A2)+1;1);ПСТР(A2;НАЙТИ(СИМВОЛ(32);A2)+1;1)&"."&ПСТР(A2;НАЙТИ(СИМВОЛ(32);A2;НАЙТИ(СИМВОЛ(32);A2)+1)+1;1))&"."

Теперь вопрос:

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

Чтобы, выделив определенный диапазон ячеек из полных ФИО, там же на выходе получить только Фамилию и инициалы. Причем в некоторых ячейках отчества может не быть (что бывает довольно часто).

P.S.: Недавно кажется нашел подходящий для этого дела макрос с функцией filtr_FIO, но в ячейках где нет Отчества, он почему-то не работает. Файл с макросом прилагаю, может получится его использовать для решения вышеуказанной задачи.

Помогите, пожалуйста…
 
 
 
#2
17.06.2017 19:23:17
Попробуйте такой вариант!
Код
Sub FIO()
Dim arr$(), msg$
Dim i&, j&, cell As Range
i = ActiveSheet.UsedRange.Rows.Row
j = Cells(Rows.Count, 1).End(xlUp).Row
For Each cell In Range(Cells(i, 1), Cells(j, 1))
    arr = Split(cell, " ")
    cell = arr(0) & " " & Left(arr(1), 1) & "." & Left(arr(2), 1) & "."
Next cell
End Sub
Изменено: Nordheim - 17.06.2017 19:24:46
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
17.06.2017 19:39:05
Ошибка. Выходит сообщение: "Subscript out of range"
И еще появилось сообщение: "Run-time error '9'"
 
 
 
#4
17.06.2017 19:51:30
Вроде работает.
Код
Sub FIO()
Dim arr$(), msg$
Dim i&, j&, cell As Range
i = ActiveSheet.UsedRange.Rows.Row
j = Cells(Rows.Count, 1).End(xlUp).Row
For Each cell In Range(Cells(i, 1), Cells(j, 1))
    msg = cell.Value
    arr = Split(msg, " ")
    cell = arr(0) & " " & Left(arr(1), 1) & "." & Left(arr(2), 1) & "."
Next cell
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#5
17.06.2017 20:00:12
Опять ошибка.
На этот раз: "Variable not defined"
Тоже не возьму в толк, в чем дело.
 
 
 
#6
17.06.2017 20:09:14
проверил. оба макроса работают в файлах сообщений 1 и 2.
 
 
 
#7
17.06.2017 20:15:21
copper-top, Простите не понял, работает или нет?
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#8
17.06.2017 20:16:25
работают.
 
 
 
#9
17.06.2017 20:16:43
Может, тогда я что-то не так делаю.
Открываю приложенный файл, запускаю макрос, и всё.
Или что-то еще?
Извините, если что не так...
 
 
 
#10
17.06.2017 20:23:46
пробуйте еще раз.
 
 
 
#11
17.06.2017 20:36:43
В прикрепленном файле находятся два макроса, FIO_1 и FIO_2, и ни тот ни другой не работают.
Какой из них удалить? А какой оставить? Тот макрос который вы мне отправили, его вставить в книгу или как модуль?
 
 
 
#12
17.06.2017 20:41:48
Смотрите файл в формате XLS.
Все работает.
 
 
 
#13
17.06.2017 20:45:35
Да, работает, но только в ячейках где указаны ФИО полностью.
А как быть с фамилией и именем без ОТЧЕСТВА?
 
 
 
#14
17.06.2017 20:48:27
Допустим, из значения "Сидоров Виктор" должно получиться "Сидоров В."
 
 
 
#15
17.06.2017 20:50:23
Макрос надо подправить...
Будете ждать или сами измените?
 
 
 
#16
17.06.2017 20:53:40
Цитата
из значения "Сидоров Виктор" должно получиться "Сидоров В.
Код
Sub FIO()
Dim arr$(), msg$
Dim i&, j&, cell As Range
i = ActiveSheet.UsedRange.Rows.Row
j = Cells(Rows.Count, 1).End(xlUp).Row
For Each cell In Range(Cells(i, 1), Cells(j, 1))
    arr = Split(cell, " ")
    If UBound(arr) = 2 Then
      cell.Offset(, 1) = arr(0) & " " & Left(arr(1), 1) & "." & Left(arr(2), 1) & "."
    Else
      cell.Offset(, 1) = arr(0) & " " & Left(arr(1), 1) & "."
    End If
Next cell
End Sub
 
 
 
#17
17.06.2017 20:53:43
В том то и дело, если бы знал :)
Подожду
 
 
 
#18
17.06.2017 21:00:49
Цитата
Kuzmich написал:
"Сидоров Виктор" должно получиться "Сидоров В.
Kuzmich!
Сидоров   Виктор Андреевич
должен быть
Сидоров   В.А.
 
 
 
#19
17.06.2017 21:07:16

Да, в результате должно получиться так:
Иванов Иван Иванович = Иванов И. И.
Сергеев Семен Семенович = Сергеев С. С.
Сидоров Виктор = Сидоров В.
 
 
 
#20
17.06.2017 21:11:45
Код
Sub asd()
    Dim arr() As String
    Dim i&
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        arr = Split(Cells(i, 1), " ")
        Select Case UBound(arr)
            Case Is = 2
            Cells(i, 1) = arr(0) & " " & Left(arr(1), 1) & "." & _
            Left(arr(2), 1) & "."
            
            Case Is = 1
            Cells(i, 1) = arr(0) & " " & Left(arr(1), 1) & "."
            
        End Select
    Next i
End Sub
 
 
 
#21
17.06.2017 21:11:55
Макрос из #17 так и делает, только в соседнем столбце
 
 
 
#22
17.06.2017 21:24:15
Цитата
Niyetkhan написал:
Сергеев Семен Семенович = Сергеев С. С.
Сидоров Виктор Андреевич = Сидоров В.
Почему Сидоров Виктор Андреевич = Сидоров В.?
 
 
 
#23
17.06.2017 21:25:40
М-да.. Делал такое в 2000 году. Модеры, тапками не забросайте, плиииз. Отжеж, даже в раре более 300кб. Просто напишите в личку, в почту. Подарю со многими вкусностями :)
Я сам - дурнее всякого примера! ...
 
 
 
#24
17.06.2017 22:34:27
Мой примитивнейший вариант - макрос.
Изменено: Мотя - 18.06.2017 13:14:52
 
 
 
#25
18.06.2017 05:40:45
Работает!

Теперь последний вопрос: нельзя ли выводить результат там же, в исходном диапазоне?
 
 
 
#26
18.06.2017 09:56:32
Замена на месте.
 
 
 
#27
18.06.2017 11:26:21
Спасибо, Вам, Юрий!
Именно этого я добивался.

Теперь работа будет спориться, благодаря Вам.
 
 
 
#28
18.06.2017 13:12:36
edit
Изменено: Мотя - 18.06.2017 13:14:10
 
 
 
#29
19.10.2020 12:29:27
Юрий М,Добрый день!
Знаю, что прошло много времени с последнего поста, можете помочь по данной теме, мне нужно сделать все тоже самое только удалить отчество, соответственно есть и строки без отчества
 
 
 
#30
19.10.2020 14:54:28
Андрей Игнатьев, Покажите в файле примере, что есть и как нужно
"Все гениальное просто, а все простое гениально!!!"
 
 
 
Страницы: 1 2 След.
Наверх