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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир 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 (0.3 Kb)


Сообщение отредактировал 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
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 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 (19.0 Kb)

ЯД: 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
Группа: Проверенные
Ранг: Обитатель
Сообщений: 452
Репутация: 78 ±
Замечаний: 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
Группа: Друзья
Ранг: Старожил
Сообщений: 1829
Репутация: 510 ±
Замечаний: 0% ±

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

Программировать проще, чем писать стихи.
 
Ответить
СообщениеСостряпал формульный вариант с дополнительными ячейками:
Автор - Светлый
Дата добавления - 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 (21.8 Kb)
 
Ответить
Сообщениетест
Автор - msdn
Дата добавления - 12.05.2017 в 16:04
Manyasha Дата: Пятница, 12.05.2017, 17:26 | Сообщение № 7
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 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 (22.8 Kb)

ЯД: 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 из 1
  • 1
Поиск:

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