Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.07.2017, 17:26   #1
Aleksey-ssx29
Новичок
Джуниор
 
Регистрация: 04.07.2017
Сообщений: 1
По умолчанию Макрос на разделение одного столбца в два по условию

Здравствуйте!
Пожалуйста, помогите составить макрос разделения одного стобца на два столбца - всё, что находится в ячейке до первой (!) найденной восьмерки (8) - оставляем в этой ячейке, а начиная с данной "8" - вырезаем в следующий столбец.

Пример:

Было "латкимщаь83739птвро8455"
Стало "латкимщаь" и "83739птвро8455"

Спасибо заранее за помощь!
Самому мне быстро не удалось понять как сделать - нубоват
Aleksey-ssx29 вне форума Ответить с цитированием
Старый 04.07.2017, 18:07   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Sub Splitter()
    Dim r As Integer
    Dim rng As Range
    Dim p As Integer
    Dim v
    Set rng = ActiveCell
    r = Cells(Rows.Count, rng.Column).End(xlUp).Row
    Do While r >= 1
        v = Cells(r, rng.Column)
        p = InStr(v, "8")
        If p > 1 Then
            Cells(r, rng.Column) = Mid(v, 1, p - 1)
            Cells(r, rng.Column + 1) = Mid(v, p)
        End If
        r = r - 1
    Loop
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 04.07.2017, 23:10   #3
svsh2016
Форумчанин
 
Регистрация: 16.06.2015
Сообщений: 100
По умолчанию

вариант функций в C1 и E1

Код:
Function vvv1$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "^.+?(?=8)"
    vvv1 = .Execute(t)(0)
 End With
End Function
Код:
Function vvv2$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "8.+$"
    vvv2 = .Execute(t)(0)
 End With
End Function
Вложения
Тип файла: xls example_04_07_2017_prog.xls (34.5 Кб, 13 просмотров)
svsh2016 вне форума Ответить с цитированием
Старый 04.07.2017, 23:53   #4
svsh2016
Форумчанин
 
Регистрация: 16.06.2015
Сообщений: 100
По умолчанию

вариант с макросом,соответствующем вышеуказанным функциям
кнопки test и повтор на листе Лист2

Код:
Sub test()
     Dim z, z1, t$, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
     ReDim z1(1 To UBound(z), 1 To 2)
  With CreateObject("VBScript.RegExp")
    For i = 1 To UBound(z): t = z(i, 1)
  .Pattern = "^.+?(?=8)":   z1(i, 1) = .Execute(t)(0)
  .Pattern = "8.+$": z1(i, 2) = .Execute(t)(0)
   Next
   Range("A1").Resize(UBound(z1), 2).Value = z1
   End With
End Sub
Вложения
Тип файла: xls example_04_07_2017_prog1.xls (44.5 Кб, 29 просмотров)
svsh2016 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос "Скрытие/удаление/добавление столбца по условию" Kapkom Microsoft Office Excel 13 15.06.2016 13:20
макросом выдернуть слова из одного столбца в другие по мудреному условию z00lu Microsoft Office Excel 10 23.06.2013 15:35
разделение столбца на два apelsun SQL, базы данных 4 20.05.2012 21:32
Выбор из одного столбца по условию выполняющемуся во втором столбце mjpv Microsoft Office Excel 2 30.04.2011 11:58
Сумма из одного столбца с числами в зависимости от интервала дат из другого столбца Severny Microsoft Office Excel 10 14.03.2011 10:13