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

Вход

Регистрация

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

 

= Мир MS Excel/извлечение определенного текста и запись в ячейки - Мир MS Excel

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

Excel 2013
всем привет,есть прайс лист,он расписан построчно,нужно чтобы эксель преобразовал
нашел одинаковые артикулы ,вписал в след столбец цвета из этих артикулов,и коды из этих артикулов .чтобы было ясно прикладываю
что должно получиться

цветами выделил для ясности
в А1-А-17 оригинал в D,E,F 1,2 то что на выхлопе должно получиться
10048 артикул,80-Е код,и цвет
такое реально вообще??
К сообщению приложен файл: 8074594.csv(0Kb)


Сообщение отредактировал msdn - Среда, 10.05.2017, 17:30
 
Ответить
Сообщениевсем привет,есть прайс лист,он расписан построчно,нужно чтобы эксель преобразовал
нашел одинаковые артикулы ,вписал в след столбец цвета из этих артикулов,и коды из этих артикулов .чтобы было ясно прикладываю
что должно получиться

цветами выделил для ясности
в А1-А-17 оригинал в D,E,F 1,2 то что на выхлопе должно получиться
10048 артикул,80-Е код,и цвет
такое реально вообще??

Автор - msdn
Дата добавления - 10.05.2017 в 17:28
Manyasha Дата: Четверг, 11.05.2017, 13:47 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1900
Репутация: 780 ±
Замечаний: 0% ±

Excel 2010, 2016
msdn, здравствуйте, так подойдет?
[vba]
Код
Sub test()
    Dim lr&, i&, data, arr(), temp, it, n%
    Dim dArt As Object, dCode As Object, dColor As Object
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    data = [a1].Resize(lr)
    Set dArt = CreateObject("scripting.dictionary")
    For i = 1 To lr
        dArt(Trim(Split(data(i, 1), " ")(0))) = arr
    Next i
    [d1].CurrentRegion.ClearContents
    [d1].Resize(dArt.Count) = Application.Transpose(dArt.keys)
    Set dCode = CreateObject("scripting.dictionary")
    Set dColor = CreateObject("scripting.dictionary")
    For Each it In dArt.keys
        n = n + 1
        For i = 1 To lr
            temp = Split(data(i, 1), " ")
            If Trim(temp(0)) = it Then
                dCode(Trim(temp(1))) = i
                dColor(Trim(temp(2))) = i
            End If
        Next i
        Cells(n, "e") = Join(dColor.keys, ";")
        Cells(n, "f") = Join(dCode.keys, ";")
        
        dCode.RemoveAll
        dColor.RemoveAll
    Next it
End Sub
[/vba]
К сообщению приложен файл: 8074594-1.xlsm(19Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеmsdn, здравствуйте, так подойдет?
[vba]
Код
Sub test()
    Dim lr&, i&, data, arr(), temp, it, n%
    Dim dArt As Object, dCode As Object, dColor As Object
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    data = [a1].Resize(lr)
    Set dArt = CreateObject("scripting.dictionary")
    For i = 1 To lr
        dArt(Trim(Split(data(i, 1), " ")(0))) = arr
    Next i
    [d1].CurrentRegion.ClearContents
    [d1].Resize(dArt.Count) = Application.Transpose(dArt.keys)
    Set dCode = CreateObject("scripting.dictionary")
    Set dColor = CreateObject("scripting.dictionary")
    For Each it In dArt.keys
        n = n + 1
        For i = 1 To lr
            temp = Split(data(i, 1), " ")
            If Trim(temp(0)) = it Then
                dCode(Trim(temp(1))) = i
                dColor(Trim(temp(2))) = i
            End If
        Next i
        Cells(n, "e") = Join(dColor.keys, ";")
        Cells(n, "f") = Join(dCode.keys, ";")
        
        dCode.RemoveAll
        dColor.RemoveAll
    Next it
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 11.05.2017 в 13:47
and_evg Дата: Четверг, 11.05.2017, 14:25 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 29 ±
Замечаний: 0% ±

Excel 2007
Всем доброго времени.
msdn, Посмотрите тут на форуме в готовых решениях кажется была пользовательская функция Сцепитьесли


Сообщение отредактировал and_evg - Четверг, 11.05.2017, 14:41
 
Ответить
СообщениеВсем доброго времени.
msdn, Посмотрите тут на форуме в готовых решениях кажется была пользовательская функция Сцепитьесли

Автор - and_evg
Дата добавления - 11.05.2017 в 14:25
Светлый Дата: Четверг, 11.05.2017, 16:04 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 286
Репутация: 68 ±
Замечаний: 0% ±

Excel 2007
Состряпал формульный вариант с дополнительными ячейками:
К сообщению приложен файл: 2049476.xlsx(12Kb)


Программировать проще, чем писать стихи.
 
Ответить
СообщениеСостряпал формульный вариант с дополнительными ячейками:

Автор - Светлый
Дата добавления - 11.05.2017 в 16:04
msdn Дата: Четверг, 11.05.2017, 18:25 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
всем спасибо,вариант manyasha просто восхитителен.потом закину вознаграждение


Сообщение отредактировал msdn - Четверг, 11.05.2017, 18:28
 
Ответить
Сообщениевсем спасибо,вариант manyasha просто восхитителен.потом закину вознаграждение

Автор - msdn
Дата добавления - 11.05.2017 в 18:25
msdn Дата: Пятница, 12.05.2017, 16:04 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
тест
К сообщению приложен файл: 0635534.xlsm(22Kb)
 
Ответить
Сообщениетест

Автор - msdn
Дата добавления - 12.05.2017 в 16:04
Manyasha Дата: Пятница, 12.05.2017, 17:26 | Сообщение № 7
Группа: Модераторы
Ранг: Старожил
Сообщений: 1900
Репутация: 780 ±
Замечаний: 0% ±

Excel 2010, 2016
msdn, вопросы по теме пишите здесь, а не в ЛС.
Цитата
в столбе B цены,можно их тоже прикрутить также ?

[vba]
Код
Sub test()
    Dim lr&, i&, data, temp, it, n%
    Dim dArt As Object, dCode As Object, dColor As Object
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    data = [a1].Resize(lr, 2)
    Set dArt = CreateObject("scripting.dictionary")
    For i = 1 To lr
        dArt(Trim(Split(data(i, 1), " ")(0))) = data(i, 2)
    Next i
    [d1].CurrentRegion.ClearContents
    [d1].Resize(dArt.Count) = Application.Transpose(dArt.keys)
    [e1].Resize(dArt.Count) = Application.Transpose(dArt.items)
    Set dCode = CreateObject("scripting.dictionary")
    Set dColor = CreateObject("scripting.dictionary")
    dColor.CompareMode = 1
    For Each it In dArt.keys
        n = n + 1
        For i = 1 To lr
            temp = Split(data(i, 1), " ")
            If Trim(temp(0)) = it Then
                dCode(Trim(temp(1))) = i
                dColor(Trim(temp(2))) = i
            End If
        Next i
        Cells(n, "i") = Join(dColor.keys, ";")
        Cells(n, "h") = Join(dCode.keys, ";")
        
        dCode.RemoveAll
        dColor.RemoveAll
    Next it
End Sub
[/vba]

Макрос немного изменила, чтобы цвета в разном регистре не дублировались.
К сообщению приложен файл: 0635534-1.xlsm(23Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеmsdn, вопросы по теме пишите здесь, а не в ЛС.
Цитата
в столбе B цены,можно их тоже прикрутить также ?

[vba]
Код
Sub test()
    Dim lr&, i&, data, temp, it, n%
    Dim dArt As Object, dCode As Object, dColor As Object
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    data = [a1].Resize(lr, 2)
    Set dArt = CreateObject("scripting.dictionary")
    For i = 1 To lr
        dArt(Trim(Split(data(i, 1), " ")(0))) = data(i, 2)
    Next i
    [d1].CurrentRegion.ClearContents
    [d1].Resize(dArt.Count) = Application.Transpose(dArt.keys)
    [e1].Resize(dArt.Count) = Application.Transpose(dArt.items)
    Set dCode = CreateObject("scripting.dictionary")
    Set dColor = CreateObject("scripting.dictionary")
    dColor.CompareMode = 1
    For Each it In dArt.keys
        n = n + 1
        For i = 1 To lr
            temp = Split(data(i, 1), " ")
            If Trim(temp(0)) = it Then
                dCode(Trim(temp(1))) = i
                dColor(Trim(temp(2))) = i
            End If
        Next i
        Cells(n, "i") = Join(dColor.keys, ";")
        Cells(n, "h") = Join(dCode.keys, ";")
        
        dCode.RemoveAll
        dColor.RemoveAll
    Next it
End Sub
[/vba]

Макрос немного изменила, чтобы цвета в разном регистре не дублировались.

Автор - Manyasha
Дата добавления - 12.05.2017 в 17:26
msdn Дата: Суббота, 13.05.2017, 15:03 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
всем спасибо,автор получила скромный гонорар
 
Ответить
Сообщениевсем спасибо,автор получила скромный гонорар

Автор - msdn
Дата добавления - 13.05.2017 в 15:03
Мир MS Excel » Вопросы и решения » Вопросы по Excel » извлечение определенного текста и запись в ячейки (Формулы/Formulas)
Страница 1 из 11
Поиск:

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