Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
28.03.2024, 17:25:01

Войти
Интересные и полезные статьи по работе с Excel и VBA можно найти в разделе ХИТРОСТИ
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Поменять местами Инициалы и Фамилию (разделены запятыми)
Страниц: [1]   Вниз
Печать
Автор Тема: Поменять местами Инициалы и Фамилию (разделены запятыми)  (Прочитано 2827 раз)
0 Пользователей и 1 Гость смотрят эту тему.
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« : 03.11.2020, 13:23:13 »

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

Очень требуется помощь в написании скрипта на vba, который в определенной части текста (после "/") поменяет местами инициалы и фамилию. Замена должна быть произведена в том же листе, в конкретном месте и нигде больше. Инициалов с фамилиями может быть от 1 до нескольких (обычно 7 максимум, но может быть и больше).

Есть формула (вот тут), которая меняет слова местами, но никак не получается ее приладить в случаях, когда имен и фамилий несколько; у меня в тексте они идут через запятую и при смене мест инициалов и фамилий - данные сильно смещаются, получается не то, что надо.

Пример.
В нужном столбике есть такие данные:
Иванов, А.А. Название статьи / Иванов А.А.
Иванов, А.А. Название статьи / Иванов А.А., Петров Б.Б.
Иванов, А.А. Название статьи / Иванов А.А., Петров Б.Б., Сидоров Г.Г.

И нужно после значка "/" все инициалы и фамилии, которые идут через запятую, поменять местами, чтобы получилось так:
Иванов, А.А. Название статьи / А.А. Иванов
Иванов, А.А. Название статьи / А.А. Иванов, Б.Б. Петров
Иванов, А.А. Название статьи / А.А. Иванов, Б.Б. Петров, Г.Г. Сидоров

Конечно это пример и фамилии везде будут разные, но первую фамилию с инициалами (Иванов, А.А.) трогать не нужно. До "/" в тексте - также могут быть фамилии и инициалы (в названиях статей, например), но их трогать не нужно. Меняются только те, что после "/". Напомню, что инициалов с фамилиями после "/" может быть от 1 до 7 (иногда больше).

"В интернете" такое обыгрывается с помощью регулярных выражений, но я не силен в программировании, поэтому мне тяжело приладить это к своей задаче.

Буду очень благодарен.
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #1 : 03.11.2020, 15:48:40 »

Функция пользователя:
Код: (vb)
Function MoveFIO(sVal As String, Optional sDelim As String = "/")
    Dim asp, asf
    Dim sBefore As String, sAfter As String, sres As String, s As String
    Dim lp As Long
    lp = InStr(1, sVal, sDelim, 1)
    If lp > 1 Then
        sBefore = Trim(Mid(sVal, 1, lp - 1))
        sAfter = Trim(Mid(sVal, lp + 1, Len(sVal) - lp))
        If sAfter <> "" Then
            asp = Split(sAfter, ", ")
            For lp = LBound(asp) To UBound(asp)
                s = asp(lp)
                asf = Split(s, " ")
                s = asf(1) & " " & asf(0)
                If sres = "" Then
                    sres = s
                Else
                    sres = sres & ", " & s
                End If
            Next
        End If
    End If
    MoveFIO = sBefore & " " & sDelim & " " & sres
End Function

Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Kuzmich
Постоялец
***

Репутация: +27/-0
Офлайн Офлайн

Сообщений: 168


Просмотр профиля
« Ответ #2 : 03.11.2020, 16:00:38 »

UDF
Код: (vb)
Function iFIO(cell As String) As String
Dim temp As String
Dim mo As Object
Dim j As Integer
  If InStr(1, cell, "/") > 0 Then
    temp = Right(cell, Len(cell) - InStrRev(cell, "/ "))
    iFIO = Left(cell, InStrRev(cell, "/ ") + 1)
     With CreateObject("VBScript.RegExp")
      .Global = True
      .Pattern = "[^,]+"
        Set mo = .Execute(temp)
       For j = 0 To mo.Count - 1
         iFIO = iFIO & Split(mo(j), " ")(2) & " " & Split(mo(j), " ")(1) & ", "
       Next
     End With
  End If
End Function
Записан
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« Ответ #3 : 03.11.2020, 16:18:22 »

Просто супер!
Спасибо ОГРОМНОЕ!
В меня "на пиво" любым удобным способом.

Kuzmich, в вашем коде - в самом конце строки ставится лишняя запятая. Как ее убрать?
Дмитрий, то что надо работает с параметром SVal. А второй параметр на что влияет (который SDelim)?
Записан
Kuzmich
Постоялец
***

Репутация: +27/-0
Офлайн Офлайн

Сообщений: 168


Просмотр профиля
« Ответ #4 : 03.11.2020, 16:29:24 »

Цитировать
в самом конце строки ставится лишняя запятая. Как ее убрать?
Добавьте после Next строку
Код: (vb)
       Next
        iFIO = Left(iFIO, Len(iFIO) - 2)
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #5 : 03.11.2020, 16:31:38 »

А второй параметр на что влияет (который SDelim)?
там указывается разделитель, который отделяет "нужную" часть от "ненужной". В Вашем случае это слеш.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« Ответ #6 : 03.11.2020, 19:16:44 »

Еще раз БОЛЬШОЕ СПАСИБО!
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru