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

Вход

Регистрация

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

 

= Мир MS Excel/Из ячеек расформировать текст по столбцам - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Из ячеек расформировать текст по столбцам (Иное/Other)
Из ячеек расформировать текст по столбцам
mts2050 Дата: Пятница, 01.07.2016, 16:58 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Есть большой файл с большим количеством характеристик товаров. Сейчас все характеристики хранятся в одной ячейке. Необходимо разбить данные ячейки по столбцам и внести нужные данные в них. У всех товаров характеристики разные. Пример файл приведен в приложении.
К сообщению приложен файл: 0097180.xlsx(11Kb)
 
Ответить
СообщениеЕсть большой файл с большим количеством характеристик товаров. Сейчас все характеристики хранятся в одной ячейке. Необходимо разбить данные ячейки по столбцам и внести нужные данные в них. У всех товаров характеристики разные. Пример файл приведен в приложении.

Автор - mts2050
Дата добавления - 01.07.2016 в 16:58
abtextime Дата: Пятница, 01.07.2016, 17:30 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Ловите, проверяйте. Через UDF

[vba]
Код
Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function
[/vba]
К сообщению приложен файл: 0097180.xlsm(18Kb)
 
Ответить
СообщениеЛовите, проверяйте. Через UDF

[vba]
Код
Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function
[/vba]

Автор - abtextime
Дата добавления - 01.07.2016 в 17:30
Nic70y Дата: Пятница, 01.07.2016, 17:33 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3485
Репутация: 722 ±
Замечаний: 0% ±

Excel 2013
Код
=ПОИСК()
и т.д.
К сообщению приложен файл: 4431914.xlsx(11Kb)


ЯД(poison) 41001841029809
+7 978 049 98 74 (мтс)
 
Ответить
Сообщение
Код
=ПОИСК()
и т.д.

Автор - Nic70y
Дата добавления - 01.07.2016 в 17:33
mts2050 Дата: Пятница, 01.07.2016, 18:06 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
А можно как то что бы он сам находил характеристики которые есть (их более 1000, вручную их искать проблематично)? Либо как их можно пересортировать в столбцы что бы потом уже заюзать данные функции?
 
Ответить
СообщениеА можно как то что бы он сам находил характеристики которые есть (их более 1000, вручную их искать проблематично)? Либо как их можно пересортировать в столбцы что бы потом уже заюзать данные функции?

Автор - mts2050
Дата добавления - 01.07.2016 в 18:06
abtextime Дата: Пятница, 01.07.2016, 19:08 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Вот наваял, сразу предупреждаю - полуфабрикат, толком не оттестенный. Но и задача не совсем тривиальная

[vba]
Код


Public Function JoinS(RR As Range) As String
    For Each R In RR
        JoinS = JoinS & R.Value
        If Right(JoinS, 1) <> vbLf Then JoinS = JoinS & vbLf
    Next
End Function

Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function

Public Function ExtrN(S As String, N As Long) As String
    Dim SS() As String
    Dim SSS() As String
    SS = Split(S, vbLf)
    SSS = Split(SS(N - 1), ":")
    ExtrN = Trim(SSS(0))
End Function
[/vba]

Файл ПЕРЕВЛОЖИЛ, добавил на втором листе автоматизации
К сообщению приложен файл: 4678675.xlsm(22Kb)


Сообщение отредактировал abtextime - Пятница, 01.07.2016, 19:14
 
Ответить
СообщениеВот наваял, сразу предупреждаю - полуфабрикат, толком не оттестенный. Но и задача не совсем тривиальная

[vba]
Код


Public Function JoinS(RR As Range) As String
    For Each R In RR
        JoinS = JoinS & R.Value
        If Right(JoinS, 1) <> vbLf Then JoinS = JoinS & vbLf
    Next
End Function

Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function

Public Function ExtrN(S As String, N As Long) As String
    Dim SS() As String
    Dim SSS() As String
    SS = Split(S, vbLf)
    SSS = Split(SS(N - 1), ":")
    ExtrN = Trim(SSS(0))
End Function
[/vba]

Файл ПЕРЕВЛОЖИЛ, добавил на втором листе автоматизации

Автор - abtextime
Дата добавления - 01.07.2016 в 19:08
abtextime Дата: Пятница, 01.07.2016, 19:22 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Важное уточнение.

Конечно, надо допилить функцию ExtrN, чтобы выдавала не просто N-й атрибут, но N-й УНИКАЛЬНЫЙ атрибут. Не так сложно, но уже нет времени. Или ждите до понедельника, или кто-то шаркнет рашпилем.

Выход простой даже для такого макроса - Ctrl-C - Ctrl-V-"Значения", Данные - Удалить дубликаты

Наверное, можно и формулами сделать эту задачу, но тут уж я умываю руки
 
Ответить
СообщениеВажное уточнение.

Конечно, надо допилить функцию ExtrN, чтобы выдавала не просто N-й атрибут, но N-й УНИКАЛЬНЫЙ атрибут. Не так сложно, но уже нет времени. Или ждите до понедельника, или кто-то шаркнет рашпилем.

Выход простой даже для такого макроса - Ctrl-C - Ctrl-V-"Значения", Данные - Удалить дубликаты

Наверное, можно и формулами сделать эту задачу, но тут уж я умываю руки

Автор - abtextime
Дата добавления - 01.07.2016 в 19:22
abtextime Дата: Понедельник, 04.07.2016, 13:33 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 427
Репутация: 60 ±
Замечаний: 0% ±

Excel 2010
Как обещал, доделал для выборки уникального атрибута
[vba]
Код

Public Function JoinS(RR As Range) As String
    For Each R In RR
        JoinS = JoinS & R.Value
        If Right(JoinS, 1) <> vbLf Then JoinS = JoinS & vbLf
    Next
End Function

Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function

Public Function ExtrN(S As String, N As Long) As String
    Dim SS() As String
    Dim SSS() As String
    SS = Split(S, vbLf)
    SSS = Split(SS(N - 1), ":")
    ExtrN = Trim(SSS(0))
End Function

Public Function MyUniq(R As Range, N As Long) As String

M = 0

For i = 1 To R.Rows.Count
    Found = False
    For j = 1 To i - 1
        If R.Cells(i, 1).Value = R.Cells(j, 1).Value Then
            Found = True
            Exit For
        End If
    Next j
    If Not Found Or i = 1 Then
        M = M + 1
        If M = N Then
            MyUniq = R.Cells(i, 1).Value
            Exit Function
        End If
    End If
Next i

End Function
[/vba]
К сообщению приложен файл: 1452817.xlsm(24Kb)


Сообщение отредактировал abtextime - Понедельник, 04.07.2016, 13:34
 
Ответить
СообщениеКак обещал, доделал для выборки уникального атрибута
[vba]
Код

Public Function JoinS(RR As Range) As String
    For Each R In RR
        JoinS = JoinS & R.Value
        If Right(JoinS, 1) <> vbLf Then JoinS = JoinS & vbLf
    Next
End Function

Public Function MyExtract(S, Attr As String) As String
    L = Len(S)
    L1 = InStr(S, Attr)
    If L1 = 0 Then Exit Function
    S = Trim(Right(S, L - L1 + 1))
    L2 = InStr(S, vbLf)
    If L2 > 0 Then S = Left(S, L2 - 1)
    MyExtract = Replace(S, Attr & ":", "")
End Function

Public Function ExtrN(S As String, N As Long) As String
    Dim SS() As String
    Dim SSS() As String
    SS = Split(S, vbLf)
    SSS = Split(SS(N - 1), ":")
    ExtrN = Trim(SSS(0))
End Function

Public Function MyUniq(R As Range, N As Long) As String

M = 0

For i = 1 To R.Rows.Count
    Found = False
    For j = 1 To i - 1
        If R.Cells(i, 1).Value = R.Cells(j, 1).Value Then
            Found = True
            Exit For
        End If
    Next j
    If Not Found Or i = 1 Then
        M = M + 1
        If M = N Then
            MyUniq = R.Cells(i, 1).Value
            Exit Function
        End If
    End If
Next i

End Function
[/vba]

Автор - abtextime
Дата добавления - 04.07.2016 в 13:33
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Из ячеек расформировать текст по столбцам (Иное/Other)
Страница 1 из 11
Поиск:

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