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

Вход

Регистрация

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

 

= Мир MS Excel/Поиск по 1 значению и вывод итогов в несколько столбцов - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Поиск по 1 значению и вывод итогов в несколько столбцов (Формулы/Formulas)
Поиск по 1 значению и вывод итогов в несколько столбцов
CoshVSR Дата: Среда, 26.07.2017, 12:11 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день!
Есть два файла. В первом БД по автомобилям, во втором некие запчасти, например дворники или брызговики.
На каждую модель автомобиля может приходиться несколько запчастей заменителей.
Как с помощью формулы или макроса настроить вывод всех запчастей и заменителей в разные столбцы.
Допустим, есть Ауди А6, во второй БД есть для Ауди А6 5 видов дворников с разными артикулами.
Нужно, чтобы в первой таблице напротив Ауди А6 в соседних столбцах подтянулись все 5 дворников.
Файл с примером в приложении
К сообщению приложен файл: example.xlsm (19.6 Kb)
 
Ответить
СообщениеДобрый день!
Есть два файла. В первом БД по автомобилям, во втором некие запчасти, например дворники или брызговики.
На каждую модель автомобиля может приходиться несколько запчастей заменителей.
Как с помощью формулы или макроса настроить вывод всех запчастей и заменителей в разные столбцы.
Допустим, есть Ауди А6, во второй БД есть для Ауди А6 5 видов дворников с разными артикулами.
Нужно, чтобы в первой таблице напротив Ауди А6 в соседних столбцах подтянулись все 5 дворников.
Файл с примером в приложении

Автор - CoshVSR
Дата добавления - 26.07.2017 в 12:11
_Boroda_ Дата: Среда, 26.07.2017, 12:36 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
Формула массива. Вводится одновременным нажатием Контрл Шифт Ентер
Код
=ЕСЛИОШИБКА(ИНДЕКС(запчасти!$C:$C;НАИМЕНЬШИЙ(ЕСЛИ(запчасти!$A$2:$A$999=$A2;СТРОКА(запчасти!$C$2:$C$999));СТОЛБЕЦ(A2)));"")

Протяните ее вниз, я не на все строки сделал
К сообщению приложен файл: example-3-1.xlsb (23.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
Формула массива. Вводится одновременным нажатием Контрл Шифт Ентер
Код
=ЕСЛИОШИБКА(ИНДЕКС(запчасти!$C:$C;НАИМЕНЬШИЙ(ЕСЛИ(запчасти!$A$2:$A$999=$A2;СТРОКА(запчасти!$C$2:$C$999));СТОЛБЕЦ(A2)));"")

Протяните ее вниз, я не на все строки сделал

Автор - _Boroda_
Дата добавления - 26.07.2017 в 12:36
CoshVSR Дата: Среда, 26.07.2017, 13:01 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо, вроде то!!
Такой вопрос. Что делать, если необходимо, чтобы данная формула работала на большом объеме данных - 20-30тыс строк в БД по тачкам и 5-7тыс артикулов по запчастям. Может быть как-то оптимизировать можно?
Или вообще проще через Access?
 
Ответить
СообщениеСпасибо, вроде то!!
Такой вопрос. Что делать, если необходимо, чтобы данная формула работала на большом объеме данных - 20-30тыс строк в БД по тачкам и 5-7тыс артикулов по запчастям. Может быть как-то оптимизировать можно?
Или вообще проще через Access?

Автор - CoshVSR
Дата добавления - 26.07.2017 в 13:01
_Boroda_ Дата: Среда, 26.07.2017, 13:17 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Это уже макросом лучше.
Или, если Вам не обязательно именно такой вид, то можно сложить обе таблицы вместе и сделать сводную
К сообщению приложен файл: example-3-2.xlsb (27.3 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто уже макросом лучше.
Или, если Вам не обязательно именно такой вид, то можно сложить обе таблицы вместе и сделать сводную

Автор - _Boroda_
Дата добавления - 26.07.2017 в 13:17
CoshVSR Дата: Среда, 26.07.2017, 13:32 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Сводная не совсем подходит, т.к. артикулы тогда располагаются вертикально.
А макрос сложный будет?
 
Ответить
СообщениеСводная не совсем подходит, т.к. артикулы тогда располагаются вертикально.
А макрос сложный будет?

Автор - CoshVSR
Дата добавления - 26.07.2017 в 13:32
AndreTM Дата: Среда, 26.07.2017, 21:20 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Макрос будет не очень сложный.
Но можно и без макроса обойтись - если задействовать Power Query.


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеМакрос будет не очень сложный.
Но можно и без макроса обойтись - если задействовать Power Query.

Автор - AndreTM
Дата добавления - 26.07.2017 в 21:20
CoshVSR Дата: Среда, 26.07.2017, 23:14 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо, а в PQ это долго реализовывать? Сроки поджимают...
 
Ответить
СообщениеСпасибо, а в PQ это долго реализовывать? Сроки поджимают...

Автор - CoshVSR
Дата добавления - 26.07.2017 в 23:14
sboy Дата: Четверг, 27.07.2017, 11:08 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Вариант макроса[vba]
Код
Dim arrArt()
    For r = 2 To shA.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim arrArt(0)
        sA = shA.Cells(r, 1).Value '1 это столбец в котором берем название авто на листе "Авто"
            With shZ.Range("a1:a" & shZ.Cells(Rows.Count, 1).End(xlUp).Row) ' столбец А на листе "запчасти" где ищем
            Set c = .Find(sA, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    arrArt(UBound(arrArt)) = c.Offset(0, 2).Value 'артикул запчасти берем со сдвигом на 2 столбца А-С
                    ReDim Preserve arrArt(UBound(arrArt) + 1)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
            End With
        If UBound(arrArt) > 0 Then shA.Cells(r, 1).Offset(0, 1).Resize(1, UBound(arrArt) + 1) = arrArt  'артикулы запчасти вносим со сдвигом на один столбец от авто А-В
   Next r
End Sub
[/vba]
upd. Откорректировал по замечанию ниже, файл перевложил
[p.s.]Конструктивная критика приветствуется, тренируюсь с массивами VBA
К сообщению приложен файл: example-3-1-1-.xlsm (35.5 Kb)


Яндекс: 410016850021169

Сообщение отредактировал sboy - Четверг, 27.07.2017, 14:09
 
Ответить
СообщениеДобрый день.
Вариант макроса[vba]
Код
Dim arrArt()
    For r = 2 To shA.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim arrArt(0)
        sA = shA.Cells(r, 1).Value '1 это столбец в котором берем название авто на листе "Авто"
            With shZ.Range("a1:a" & shZ.Cells(Rows.Count, 1).End(xlUp).Row) ' столбец А на листе "запчасти" где ищем
            Set c = .Find(sA, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    arrArt(UBound(arrArt)) = c.Offset(0, 2).Value 'артикул запчасти берем со сдвигом на 2 столбца А-С
                    ReDim Preserve arrArt(UBound(arrArt) + 1)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
            End With
        If UBound(arrArt) > 0 Then shA.Cells(r, 1).Offset(0, 1).Resize(1, UBound(arrArt) + 1) = arrArt  'артикулы запчасти вносим со сдвигом на один столбец от авто А-В
   Next r
End Sub
[/vba]
upd. Откорректировал по замечанию ниже, файл перевложил
[p.s.]Конструктивная критика приветствуется, тренируюсь с массивами VBA

Автор - sboy
Дата добавления - 27.07.2017 в 11:08
Manyasha Дата: Четверг, 27.07.2017, 11:33 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Сергей, а зачем проверять размерность массива? Так тоже правильно вроде:
[vba]
Код
'                    If UBound(arrArt) = 0 Then
'                        arrArt(0) = c.Offset(0, 2).Value
'                        ReDim Preserve arrArt(UBound(arrArt) + 1)
'                    Else
                        arrArt(UBound(arrArt)) = c.Offset(0, 2).Value
                        ReDim Preserve arrArt(UBound(arrArt) + 1)
'                    End If
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеСергей, а зачем проверять размерность массива? Так тоже правильно вроде:
[vba]
Код
'                    If UBound(arrArt) = 0 Then
'                        arrArt(0) = c.Offset(0, 2).Value
'                        ReDim Preserve arrArt(UBound(arrArt) + 1)
'                    Else
                        arrArt(UBound(arrArt)) = c.Offset(0, 2).Value
                        ReDim Preserve arrArt(UBound(arrArt) + 1)
'                    End If
[/vba]

Автор - Manyasha
Дата добавления - 27.07.2017 в 11:33
sboy Дата: Четверг, 27.07.2017, 12:17 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Manyasha, Точно, сначала был немного другой вариант увеличения массива, лишнее забыл убрать) Спасибо!


Яндекс: 410016850021169
 
Ответить
СообщениеManyasha, Точно, сначала был немного другой вариант увеличения массива, лишнее забыл убрать) Спасибо!

Автор - sboy
Дата добавления - 27.07.2017 в 12:17
CoshVSR Дата: Четверг, 27.07.2017, 13:27 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Уточните пожалуйста, в коде, какие параметры отвечают за следующее:
1. Номер столбца, в котором ищется название авто.
2. Номер столбца, с которого макрос начинает "разносить" значения артикулов
3. Номер столбца в запчастях, в котором макрос ищет соответствие названию авто из п.1
 
Ответить
СообщениеУточните пожалуйста, в коде, какие параметры отвечают за следующее:
1. Номер столбца, в котором ищется название авто.
2. Номер столбца, с которого макрос начинает "разносить" значения артикулов
3. Номер столбца в запчастях, в котором макрос ищет соответствие названию авто из п.1

Автор - CoshVSR
Дата добавления - 27.07.2017 в 13:27
sboy Дата: Четверг, 27.07.2017, 14:04 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
добавил комментарии в код макроса


Яндекс: 410016850021169

Сообщение отредактировал sboy - Четверг, 27.07.2017, 14:10
 
Ответить
Сообщениедобавил комментарии в код макроса

Автор - sboy
Дата добавления - 27.07.2017 в 14:04
CoshVSR Дата: Пятница, 28.07.2017, 12:09 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Скажите, а можно как-то к этому макросу прикрутить индикацию статуса выполнения?
Просто он "пилит" уже полчаса, при этом Excel не висит, нагрузка на процессор идёт...
 
Ответить
СообщениеСкажите, а можно как-то к этому макросу прикрутить индикацию статуса выполнения?
Просто он "пилит" уже полчаса, при этом Excel не висит, нагрузка на процессор идёт...

Автор - CoshVSR
Дата добавления - 28.07.2017 в 12:09
китин Дата: Пятница, 28.07.2017, 12:14 | Сообщение № 14
Группа: Модераторы
Ранг: Экселист
Сообщений: 7013
Репутация: 1073 ±
Замечаний: 0% ±

Excel 2007;2010;2016
Почитайте тут


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
СообщениеПочитайте тут

Автор - китин
Дата добавления - 28.07.2017 в 12:14
sboy Дата: Пятница, 28.07.2017, 12:37 | Сообщение № 15
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
CoshVSR, можно еще отключить обновление экрана, будет быстрее
в начало макроса [vba]
Код
Application.ScreenUpdating = False
[/vba]
в конец [vba]
Код
Application.ScreenUpdating = True
[/vba]


Яндекс: 410016850021169
 
Ответить
СообщениеCoshVSR, можно еще отключить обновление экрана, будет быстрее
в начало макроса [vba]
Код
Application.ScreenUpdating = False
[/vba]
в конец [vba]
Код
Application.ScreenUpdating = True
[/vba]

Автор - sboy
Дата добавления - 28.07.2017 в 12:37
CoshVSR Дата: Пятница, 28.07.2017, 13:11 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
В итоге макрос обработал объем таблицы 24000*60 за час.
Я так понимаю, тут все упирается исключительно в мощность ПК? Никак оптимизировать нельзя?
 
Ответить
СообщениеВ итоге макрос обработал объем таблицы 24000*60 за час.
Я так понимаю, тут все упирается исключительно в мощность ПК? Никак оптимизировать нельзя?

Автор - CoshVSR
Дата добавления - 28.07.2017 в 13:11
Manyasha Дата: Пятница, 28.07.2017, 16:04 | Сообщение № 17
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
CoshVSR, попробуйте такой вариант:
[vba]
Код
Sub test()
    Application.ScreenUpdating = False
    Dim shA As Worksheet, shZ As Worksheet, dic As Object
    Dim arrZ, temp$()
    Dim i&, lr&, dItem$
    
    Set shA = Sheets("Авто")
    Set shZ = Sheets("запчасти")
    'Будем записывать все артикулы в словарь (авто - ключ, массив артикулов - значение)
    Set dic = CreateObject("scripting.dictionary")
    
    'Номер последней строки на листе запчасти по столбцу 1
    lr = shZ.Cells(Rows.Count, 1).End(xlUp).Row
    'Запоминаем в массив первые 3 столбца на листе запчасти
    arrZ = shZ.Cells(2, 1).Resize(lr - 1, 3).Value
    'идем по строкам этого массива
    For i = 1 To UBound(arrZ)
        'Если в словаре нет такого авто
        If Not dic.exists(Trim(arrZ(i, 1))) Then 'arrZ(i, 1) - авто в 1-м столбце
            ReDim temp(0)
            'запоминаем артикул во временный массив
            temp(0) = Trim(arrZ(i, 3)) 'arrZ(i, 3) - артикул в 3-м столбце
        Else
        'Если есть, считываем во временный массив все артикулы данного авто arrZ(i, 1)
            temp = dic(Trim(arrZ(i, 1)))
            'Увеличиваем размерность массива на 1
            ReDim Preserve temp(0 To UBound(temp) + 1)
            'В последний элемент массива запоминаем текущий артикул arrZ(i, 3)
            temp(UBound(temp)) = Trim(arrZ(i, 3))
        End If
        '
        dic(Trim(arrZ(i, 1))) = temp
    Next i
    
    'На данном этапе у нас сформировался словарь (набор пар ключ-значение), у которого авто в ключах,
    'массив артикулов для данного авто в значениях
    
    ''Номер последней строки на листе авто по столбцу 1
    lr = shA.Cells(Rows.Count, 1).End(xlUp).Row
    'Очищаем старые значения на листе авто
    shA.[a1].CurrentRegion.Offset(1, 1).ClearContents
    With shA
        'Идем по строкам
        For i = 2 To lr
            'запомнили авто из 1-го столбца в переменную dItem
            dItem = Trim(.Cells(i, 1))
            'Если такое авто есть в словаре
            If dic.exists(dItem) Then
                'записываем на лист артикулы (начиная со 2-го столбца и вправо)
                .Cells(i, 2).Resize(, UBound(dic(dItem)) + 1) = dic(dItem)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Пятница, 28.07.2017, 17:33
 
Ответить
СообщениеCoshVSR, попробуйте такой вариант:
[vba]
Код
Sub test()
    Application.ScreenUpdating = False
    Dim shA As Worksheet, shZ As Worksheet, dic As Object
    Dim arrZ, temp$()
    Dim i&, lr&, dItem$
    
    Set shA = Sheets("Авто")
    Set shZ = Sheets("запчасти")
    'Будем записывать все артикулы в словарь (авто - ключ, массив артикулов - значение)
    Set dic = CreateObject("scripting.dictionary")
    
    'Номер последней строки на листе запчасти по столбцу 1
    lr = shZ.Cells(Rows.Count, 1).End(xlUp).Row
    'Запоминаем в массив первые 3 столбца на листе запчасти
    arrZ = shZ.Cells(2, 1).Resize(lr - 1, 3).Value
    'идем по строкам этого массива
    For i = 1 To UBound(arrZ)
        'Если в словаре нет такого авто
        If Not dic.exists(Trim(arrZ(i, 1))) Then 'arrZ(i, 1) - авто в 1-м столбце
            ReDim temp(0)
            'запоминаем артикул во временный массив
            temp(0) = Trim(arrZ(i, 3)) 'arrZ(i, 3) - артикул в 3-м столбце
        Else
        'Если есть, считываем во временный массив все артикулы данного авто arrZ(i, 1)
            temp = dic(Trim(arrZ(i, 1)))
            'Увеличиваем размерность массива на 1
            ReDim Preserve temp(0 To UBound(temp) + 1)
            'В последний элемент массива запоминаем текущий артикул arrZ(i, 3)
            temp(UBound(temp)) = Trim(arrZ(i, 3))
        End If
        '
        dic(Trim(arrZ(i, 1))) = temp
    Next i
    
    'На данном этапе у нас сформировался словарь (набор пар ключ-значение), у которого авто в ключах,
    'массив артикулов для данного авто в значениях
    
    ''Номер последней строки на листе авто по столбцу 1
    lr = shA.Cells(Rows.Count, 1).End(xlUp).Row
    'Очищаем старые значения на листе авто
    shA.[a1].CurrentRegion.Offset(1, 1).ClearContents
    With shA
        'Идем по строкам
        For i = 2 To lr
            'запомнили авто из 1-го столбца в переменную dItem
            dItem = Trim(.Cells(i, 1))
            'Если такое авто есть в словаре
            If dic.exists(dItem) Then
                'записываем на лист артикулы (начиная со 2-го столбца и вправо)
                .Cells(i, 2).Resize(, UBound(dic(dItem)) + 1) = dic(dItem)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 28.07.2017 в 16:04
CoshVSR Дата: Пятница, 28.07.2017, 16:48 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо, а можете также написать комментарии к коду ?
1. Номер столбца, в котором ищется название авто.
2. Номер столбца, с которого макрос начинает "разносить" значения артикулов
3. Номер столбца в запчастях, в котором макрос ищет соответствие названию авто из п.1
 
Ответить
СообщениеСпасибо, а можете также написать комментарии к коду ?
1. Номер столбца, в котором ищется название авто.
2. Номер столбца, с которого макрос начинает "разносить" значения артикулов
3. Номер столбца в запчастях, в котором макрос ищет соответствие названию авто из п.1

Автор - CoshVSR
Дата добавления - 28.07.2017 в 16:48
Manyasha Дата: Пятница, 28.07.2017, 17:34 | Сообщение № 19
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
CoshVSR, добавила комменты выше.
Новичку сложно будет разобраться со словарями и массивами. Лучше бы скинули файл с реальной структурой таблиц, тогда и код бы править не пришлось...


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеCoshVSR, добавила комменты выше.
Новичку сложно будет разобраться со словарями и массивами. Лучше бы скинули файл с реальной структурой таблиц, тогда и код бы править не пришлось...

Автор - Manyasha
Дата добавления - 28.07.2017 в 17:34
CoshVSR Дата: Суббота, 29.07.2017, 12:04 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо, но я попробую в коде разобраться, иначе смысл был спрашивать, потом однотипные вопросы плодить. Лучше на данном примере научусь.
 
Ответить
СообщениеСпасибо, но я попробую в коде разобраться, иначе смысл был спрашивать, потом однотипные вопросы плодить. Лучше на данном примере научусь.

Автор - CoshVSR
Дата добавления - 29.07.2017 в 12:04
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Поиск по 1 значению и вывод итогов в несколько столбцов (Формулы/Formulas)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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