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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 20.07.2012, 22:54   #1
Rmzn
Пользователь
 
Регистрация: 16.07.2012
Сообщений: 15
По умолчанию Собрать нужную информацию из нескольких столбцов в один

Доброй ночи! Помогите собрать нужную информацию из нескольких столбцов в один с разделительным символом *. Из столбцов где идут серия и номер паспорта, потом предметы и их результаты надо вывести в один столбец серию*номер* и резултаты.
Rmzn вне форума Ответить с цитированием
Старый 20.07.2012, 23:00   #2
Rmzn
Пользователь
 
Регистрация: 16.07.2012
Сообщений: 15
По умолчанию

Забыл прикрепить пример что должно получиться из чего
Вложения
Тип файла: rar Primer.rar (11.3 Кб, 18 просмотров)
Rmzn вне форума Ответить с цитированием
Старый 21.07.2012, 12:09   #3
nerv
Форумчанин
 
Аватар для nerv
 
Регистрация: 26.04.2010
Сообщений: 450
По умолчанию

Код:
Function getInfo(ByRef rng As Range) As String
    getInfo = getSeries(rng.Cells(1).Value) & "*" & _
              getNumber(rng.Cells(1).Value) & _
              getSubject(rng.Cells(rng.Cells.Count).Value)
End Function


Private Function getSeries(ByRef text As String) As String
    Static re As Object
    If re Is Nothing Then
        Set re = CreateObject("vbscript.regexp")
        re.Pattern = "\d\d\s\d\d"
    End If
    On Error Resume Next
    getSeries = re.Execute(text).Item(0)
    getSeries = Replace(getSeries, " ", "")
End Function


Private Function getNumber(ByRef text As String) As String
    Static re As Object
    If re Is Nothing Then
        Set re = CreateObject("vbscript.regexp")
        re.Pattern = "\d{6}"
    End If
    On Error Resume Next
    getNumber = re.Execute(text).Item(0)
End Function


Private Function getSubject(ByRef text As String) As String
    Static re As Object
    Dim elem As Object
    If re Is Nothing Then
        Set re = CreateObject("vbscript.regexp")
        re.Pattern = "-\s?(\d+)"
        re.Global = True
    End If
    On Error Resume Next
    For Each elem In re.Execute(text)
        getSubject = getSubject & "*" & elem.Submatches(0)
    Next
End Function
Вложения
Тип файла: zip из этого.zip (10.5 Кб, 22 просмотров)
Тишина – самый громкий звук
nerv вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Собрать данные с нескольких листов и книг dana11 Microsoft Office Excel 14 20.01.2012 16:15
Как собрать информацию с двух листов в один? kachorro Microsoft Office Excel 12 15.12.2011 12:19
авт. перенос данных из нескольких столбцов одной таблицы в один столбец другой таблицы A_ALL Microsoft Office Access 7 24.08.2009 21:13
Помогите собрать таблицу из нескольких файлов repka Microsoft Office Excel 16 08.04.2009 12:56
Копирование нескольких столбцов в один AChrist Microsoft Office Excel 4 16.03.2009 06:34