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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос для поиска определенных значений по списку - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для поиска определенных значений по списку (Макросы/Sub)
Макрос для поиска определенных значений по списку
Shumik916 Дата: Четверг, 17.01.2019, 12:20 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всем привет. Я тут первый раз и нужна помощь в создании макроса. Есть файл с большим кол-вом товара его продажей и остатком, в котором нужно найти только определенный товар по списку из другого листа. Можно его либо выделять, либо просто переносить ниже. Макросы изучала давно еще в университете и помню как они отлично помогали в таких вопросах, но память старушка дает о себе знать и как это сделать я уже совсем не помню((( Буду рада помощи, очень!
Пример файла приложила
К сообщению приложен файл: 4034141.xls(26.5 Kb)
 
Ответить
СообщениеВсем привет. Я тут первый раз и нужна помощь в создании макроса. Есть файл с большим кол-вом товара его продажей и остатком, в котором нужно найти только определенный товар по списку из другого листа. Можно его либо выделять, либо просто переносить ниже. Макросы изучала давно еще в университете и помню как они отлично помогали в таких вопросах, но память старушка дает о себе знать и как это сделать я уже совсем не помню((( Буду рада помощи, очень!
Пример файла приложила

Автор - Shumik916
Дата добавления - 17.01.2019 в 12:20
_Boroda_ Дата: Четверг, 17.01.2019, 12:43 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А Условным форматированием не подойдет ли случайно?
Код
=ПОИСКПОЗ($A2;'Товар который нужно найти в п.с'!$A$2:$A$999;)
К сообщению приложен файл: 4034141_1.xls(41.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА Условным форматированием не подойдет ли случайно?
Код
=ПОИСКПОЗ($A2;'Товар который нужно найти в п.с'!$A$2:$A$999;)

Автор - _Boroda_
Дата добавления - 17.01.2019 в 12:43
Shumik916 Дата: Четверг, 17.01.2019, 13:17 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, у меня не получилось, пишет что нельзя формулу применить к другому листу....
 
Ответить
Сообщение_Boroda_, у меня не получилось, пишет что нельзя формулу применить к другому листу....

Автор - Shumik916
Дата добавления - 17.01.2019 в 13:17
Shumik916 Дата: Четверг, 17.01.2019, 13:21 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Я нашла на форуме что-то похожее, применила к своей таблице и он выдал ниже списком наименование, но мне нужно, чтобы еще и столбец с остатком тоже вместе с наименованием выделялся
[vba]
Код
Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, x As Range, dic As Object
    Dim i&, lr&, iKey$
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    Set dic = CreateObject("scripting.dictionary")
    With sh1
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            dic(iKey) = i
        Next i
    End With
    With sh2
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            If dic.exists(iKey) Then
                sh1.Cells(dic(iKey), "e") = .Cells(i, "e")
            Else
                lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                sh1.Cells(lr, "b") = .Cells(i, "b")
                sh1.Cells(lr, "c") = .Cells(i, "c")
                sh1.Cells(lr, "d") = .Cells(i, "d")
                sh1.Cells(lr, "e") = .Cells(i, "e")
            End If
        Next i
    End With
End Sub
[/vba]


Сообщение отредактировал Shumik916 - Четверг, 17.01.2019, 13:52
 
Ответить
СообщениеЯ нашла на форуме что-то похожее, применила к своей таблице и он выдал ниже списком наименование, но мне нужно, чтобы еще и столбец с остатком тоже вместе с наименованием выделялся
[vba]
Код
Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, x As Range, dic As Object
    Dim i&, lr&, iKey$
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    Set dic = CreateObject("scripting.dictionary")
    With sh1
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            dic(iKey) = i
        Next i
    End With
    With sh2
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            iKey = Trim(.Cells(i, "b") & "@" & .Cells(i, "c") & "@" & .Cells(i, "d"))
            If dic.exists(iKey) Then
                sh1.Cells(dic(iKey), "e") = .Cells(i, "e")
            Else
                lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                sh1.Cells(lr, "b") = .Cells(i, "b")
                sh1.Cells(lr, "c") = .Cells(i, "c")
                sh1.Cells(lr, "d") = .Cells(i, "d")
                sh1.Cells(lr, "e") = .Cells(i, "e")
            End If
        Next i
    End With
End Sub
[/vba]

Автор - Shumik916
Дата добавления - 17.01.2019 в 13:21
_Boroda_ Дата: Четверг, 17.01.2019, 13:24 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А у Вас Excel какой? В профиле 2016, там можно. Можно еще в 2013 и в 2010
А в остальных версиях нужно импользовать именованный диапазон (Контрл F3). С той же формулой. Только когда будете создавать его, то сначала встаньте в ячейку А2 (А2 потому, что эта ячейка в формуле используется
К сообщению приложен файл: 4034141_2.xls(41.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА у Вас Excel какой? В профиле 2016, там можно. Можно еще в 2013 и в 2010
А в остальных версиях нужно импользовать именованный диапазон (Контрл F3). С той же формулой. Только когда будете создавать его, то сначала встаньте в ячейку А2 (А2 потому, что эта ячейка в формуле используется

Автор - _Boroda_
Дата добавления - 17.01.2019 в 13:24
_Boroda_ Дата: Четверг, 17.01.2019, 13:25 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
- Прочитайте Правила форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)


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

Автор - _Boroda_
Дата добавления - 17.01.2019 в 13:25
Shumik916 Дата: Четверг, 17.01.2019, 13:35 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, у меня 2007. Так, что-то именованный диапазон для меня какой-то темный лес...
Код, вроде, поправила.
 
Ответить
Сообщение_Boroda_, у меня 2007. Так, что-то именованный диапазон для меня какой-то темный лес...
Код, вроде, поправила.

Автор - Shumik916
Дата добавления - 17.01.2019 в 13:35
_Boroda_ Дата: Четверг, 17.01.2019, 14:04 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Ага, а макросы - это лес светлее, чем именованные диапазоны :D . Вы файл смотрели из моего предыдущего сообщения? Если что-то конкретно не совсем понятно - спрашивайте, для того форум и сделан

Если все-таки есть непреодолимое желание помакросить, то вот
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 1).End(3).Row
            aaa = .Item(sh2.Cells(i, 1).Value & "")
        Next i
        r1_ = Cells(Rows.Count, 1).End(3).Row
        For i = 2 To r1_
            If .exists(Cells(i, 1) & "") Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]


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

Если все-таки есть непреодолимое желание помакросить, то вот
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 1).End(3).Row
            aaa = .Item(sh2.Cells(i, 1).Value & "")
        Next i
        r1_ = Cells(Rows.Count, 1).End(3).Row
        For i = 2 To r1_
            If .exists(Cells(i, 1) & "") Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 17.01.2019 в 14:04
Shumik916 Дата: Четверг, 17.01.2019, 14:47 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, просто мне кажется макрос включил и вот тебе счастье, а тут у меня иксель не того года, формулы пиши, выделяй.
А тут оп, и вы помогли, макрос написали.
Но только теперь на мой большой объем товара он чет не работает.
 
Ответить
Сообщение_Boroda_, просто мне кажется макрос включил и вот тебе счастье, а тут у меня иксель не того года, формулы пиши, выделяй.
А тут оп, и вы помогли, макрос написали.
Но только теперь на мой большой объем товара он чет не работает.

Автор - Shumik916
Дата добавления - 17.01.2019 в 14:47
_Boroda_ Дата: Четверг, 17.01.2019, 14:56 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Пишите в личке адрес, я вечером подъеду посмотрю :D

Где не работает, ругается или просто не работает, если ругается, то что пишет и где выделяет желтым строку?

Если у Вас вверху написано Option Explicit, то в макросе второй строкой напишите
[vba]
Код
Dim sh2, slov, i, aaa, r1_, x_
[/vba]
Или сотрите Option Explicit (не рекомендуется Майкрософтом)


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

Где не работает, ругается или просто не работает, если ругается, то что пишет и где выделяет желтым строку?

Если у Вас вверху написано Option Explicit, то в макросе второй строкой напишите
[vba]
Код
Dim sh2, slov, i, aaa, r1_, x_
[/vba]
Или сотрите Option Explicit (не рекомендуется Майкрософтом)

Автор - _Boroda_
Дата добавления - 17.01.2019 в 14:56
Shumik916 Дата: Четверг, 17.01.2019, 15:05 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, вы знаете, а макрос по прошествию лет все-таки тоже темный лес %) )) ошибок нет, желтым не выделяет, просто не вижу после его включения сноски с нужным мне товаром.

А если я вставляю тот макрос, что кинула выше, который нашла, то он работает, но как и писала, не выдает так же остатка, а это важно.
 
Ответить
Сообщение_Boroda_, вы знаете, а макрос по прошествию лет все-таки тоже темный лес %) )) ошибок нет, желтым не выделяет, просто не вижу после его включения сноски с нужным мне товаром.

А если я вставляю тот макрос, что кинула выше, который нашла, то он работает, но как и писала, не выдает так же остатка, а это важно.

Автор - Shumik916
Дата добавления - 17.01.2019 в 15:05
_Boroda_ Дата: Четверг, 17.01.2019, 15:14 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Ну тогда наверное нужно посмотреть на кусок реального фалйла. Гнетут меня смутные сомнения, что у Вас там в артикулах (да, мы проверяем не по названию, а по артикулу, иначе зачем он вообще нужен?) или несовпадение, или лишние пробелы. Попробуйте так (если не получится, то покажите файла кусок)
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 1).End(3).Row
            aaa = Trim(.Item(sh2.Cells(i, 1).Value & ""))
        Next i
        r1_ = Cells(Rows.Count, 1).End(3).Row
        For i = 2 To r1_
            If .exists(Trim(Cells(i, 1) & "")) Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНу тогда наверное нужно посмотреть на кусок реального фалйла. Гнетут меня смутные сомнения, что у Вас там в артикулах (да, мы проверяем не по названию, а по артикулу, иначе зачем он вообще нужен?) или несовпадение, или лишние пробелы. Попробуйте так (если не получится, то покажите файла кусок)
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 1).End(3).Row
            aaa = Trim(.Item(sh2.Cells(i, 1).Value & ""))
        Next i
        r1_ = Cells(Rows.Count, 1).End(3).Row
        For i = 2 To r1_
            If .exists(Trim(Cells(i, 1) & "")) Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 17.01.2019 в 15:14
Shumik916 Дата: Четверг, 17.01.2019, 15:50 | Сообщение № 13
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, а мне нужно по названию именно, артикул просто вставляется автоматом у меня, извините, что я его и вам в образец пихнула, на автомате просто.
 
Ответить
Сообщение_Boroda_, а мне нужно по названию именно, артикул просто вставляется автоматом у меня, извините, что я его и вам в образец пихнула, на автомате просто.

Автор - Shumik916
Дата добавления - 17.01.2019 в 15:50
_Boroda_ Дата: Четверг, 17.01.2019, 16:17 | Сообщение № 14
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15576
Репутация: 6077 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Охохонюшки. Ловите
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 2).End(3).Row
            aaa = Trim(.Item(sh2.Cells(i, 2).Value & ""))
        Next i
        r1_ = Cells(Rows.Count, 2).End(3).Row
        For i = 2 To r1_
            If .exists(Trim(Cells(i, 2) & "")) Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеОхохонюшки. Ловите
[vba]
Код
Sub test()
    Application.ScreenUpdating = 0
    Set sh2 = ThisWorkbook.Sheets(2)
    Set slov = CreateObject("scripting.dictionary")
    With slov
        For i = 2 To sh2.Cells(Rows.Count, 2).End(3).Row
            aaa = Trim(.Item(sh2.Cells(i, 2).Value & ""))
        Next i
        r1_ = Cells(Rows.Count, 2).End(3).Row
        For i = 2 To r1_
            If .exists(Trim(Cells(i, 2) & "")) Then
                x_ = x_ + 1
                Cells(i, 1).Resize(1, 4).Copy Cells(r1_ + x_ + 1, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 17.01.2019 в 16:17
Shumik916 Дата: Четверг, 17.01.2019, 17:23 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, ооооой, спасибо вам огромнейшее yes
 
Ответить
Сообщение_Boroda_, ооооой, спасибо вам огромнейшее yes

Автор - Shumik916
Дата добавления - 17.01.2019 в 17:23
boa Дата: Пятница, 18.01.2019, 17:15 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 405
Репутация: 113 ±
Замечаний: 0% ±

2013, 365
Shumik916,
Есть у меня такой макрос
К сообщению приложен файл: SearchByList.xlsb(22.7 Kb)


 
Ответить
СообщениеShumik916,
Есть у меня такой макрос

Автор - boa
Дата добавления - 18.01.2019 в 17:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для поиска определенных значений по списку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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