Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение серийных номеров в соответствии с типом оборудования и городом поставки
 
#1
11.02.2021 11:37:31
Добрый день.

Добрые самаритяне, прошу о помощи :oops:
задача не простая, но я верю, что здесь есть гуру в мире эксель:

заполнить серийные номера во вкладке "Форма" в соответствии с кодом оборудования и при условии что они относятся к определенному городу.
Во вкладке "Серийные номера" общий список городов с кодами оборудования и соответствующими им серийниками.
Название города, для которого мы ищем в данный момент серийники, нужно брать из вкладки "Разное", ячейка B2.
Все серийники для одного кода нужно подтянуть так, чтобы они были в одной ячейке через пробел.

В код добавить условие, при котором заполнение серийных номеров для определенных кодов не требуется.
код пока отключить.
Расположение листов и форм для заполнения в моей тулзе именно такое.
 
 
 
 
#2
11.02.2021 12:02:36
Покажите в примере как должно заполняться (заполните в ручную несколько позиций)
 
 
 
#3
11.02.2021 12:03:34
Если правильно понял
Код
Sub Подтянуть()
    Dim r, lr, m, sl: Set sl = CreateObject("Scripting.Dictionary")
    
    With Worksheets("Серийные номера")
        lr = .Cells(.Rows.Count, 9).End(xlUp).Row
        m = .Cells(1, 9).Resize(lr, 2).Value
    End With
    For r = 2 To lr
        sl(m(r, 1)) = VBA.Trim(sl(m(r, 1))) & " " & m(r, 2)
    Next r
    
    With Worksheets("Форма")
        lr = .Cells(.Rows.Count, 2).End(xlUp).Row
        m = .Cells(7, 2).Resize(lr, 5).Value
        For r = 1 To lr
            If sl.exists(m(r, 1)) Then
                m(r, 5) = sl(m(r, 1))
            End If
        Next r
        .Cells(7, 2).Resize(lr, 5) = m
    End With

End Sub
Изменено: Александр Моторин - 11.02.2021 12:05:10
 
 
 
#4
11.02.2021 12:43:37
Александр Моторин,
макрос рабочий, но не так как нужно.
он находит все серийники для одного кода и тянет их внезависимости от города.
Но название города - главное условие. получается что к Новосибу подтянулись серийники для кода1 от МСК. а должны быть только от Новосиба.
приложил пример как должно получится.
добавьте в код условие, пожалуйста.
я изменил название страниц на англ, т.к. у меня нет возможности в системе поменять язык на русский.  
 
 
 
#5
11.02.2021 14:13:53
А просто сводная таблица Вам не подойдет. И не понятно, где в форме находится КРИТЕРИЙ поиска "НОВОСИБ"
Изменено: msi2102 - 11.02.2021 14:16:48
 
 
 
#6
11.02.2021 15:36:18
msi2102,
почему-то многие сичтают своим долгом приплести сводную там, где она не нужна.
серьезно, второй раз пишу тему с макросом и мне суют в морду эту сводную, зачем вы это делаете..........
 
 
 
#7
11.02.2021 15:49:01
Цитата
Сергей Алешин написал:
суют в морду
так  вы  благодарите помогающего. Думаю он сейчас вам сразу же предложит другой вариант.
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#8
11.02.2021 16:01:52
Mershik,
вы мне помогли в другой теме и я вам очень признателен.
вы сразу ответили по теме и практически полностью решили вопрос.

но, как в той теме так и в этой, вместо реальной помощи предлагают сводные, почему как вы сами думаете?

я умею ими пользоваться, а люди, для которых я пытаюсь со своими скудными познаниями сделать тулзу, не умеют.
и все это для них, чтобы человек нажал 4-5 кнопок и получил файл, с которым он должен провести основную работу:
выяснить что куда доехало/перемещено и прочее, а они сейчас тратят на простые операции в эксель по неск часов, когда можно с помощью сводных и формул сделать за 5 минут, но они этого (повторяюсь) не умеют. и сильно тормозят процесс, из-за чего получают по башке от руководства. у меня проблем нет, я просто хочу помочь другим.
 
 
 
#9
11.02.2021 16:04:52
Цитата
Сергей Алешин написал: как в той теме так и в этой, вместо реальной помощи предлагают сводные, почему как вы сами думаете?
Потому что тема уже не только для Вас, она останется  и, возможно, решение, которое не устраивает Вас, пригодится другим.

Я бы умерил пыл и извинился... Иначе, увидев Ваше отношение, многие пройдут мимо.
 
 
 
#10
11.02.2021 16:18:28
vikttur,
Цитата
vikttur написал:
решение, которое не устраивает Вас, пригодится другим.
простите, как это можно назвать решением? прочитайте название темы.


господин msi2102, делаю вам замечание за спам :excl:

ох, тыщу лет не писал в инетах, уж и забыл каково это.
всем мир, тему можно закрывать. решили вопрос сводной таблицей :D  
 
 
 
#11
11.02.2021 16:19:47
Цитата
vikttur написал:
Я бы умерил пыл и извинился... Иначе, увидев Ваше отношение, многие пройдут мимо.
прислушайтесь совет.

если правильно понял - для первого примера вашего
пы.сы данные по Новосибу и так далее должны быть отсортированы и расположены вместе (МСК МСК МСК НОВОСИБ НОВСОБ и тд.) как у вас сейчас вообщем
Код
Sub mrshkei()
Dim r As Long, r2 As Long, lr As Long, cell As Range, k As Long, sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Серийные номера"): Set sh2 = Worksheets("Форма")
lr = sh2.Cells(Rows.Count, 2).End(xlUp).Row
k = Application.WorksheetFunction.CountIf(sh.Columns(1), "Новосиб")
Set cell = sh.Columns(1).Find("Новосиб")
For r2 = 7 To lr
    For r = cell.Row To cell.Row + k - 1
        If sh2.Cells(r2, 2) = sh.Cells(r, 9) Then
            If x = "" Then
                x = sh.Cells(r, 10)
            Else
                x = x & " " & sh.Cells(r, 10)
            End If
        End If
    Next r
    sh2.Cells(r2, 6) = x
    x = ""
Next r2
End Sub
Изменено: Mershik - 11.02.2021 16:38:10
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#12
11.02.2021 16:26:24
Цитата
Сергей Алешин написал: прочитайте название темы.
Вот-вот... Тема не только для Вас и название давно изменено
 
 
 
#13
11.02.2021 16:29:37
vikttur,

обычно стараюсь проходить мимо спама и прочего, но не удержался.
простите.
 
 
 
#14
11.02.2021 17:42:09
Цитата
Mershik написал:
изменил немного ваш код:
Название города, для которого мы ищем в данный момент серийники, нужно брать из вкладки "Разное", ячейка B2.
Код
Sub mrshkei()
Dim r As Long, r2 As Long, lr As Long, cell As Range, k As Long, sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Серийные номера"): Set sh2 = Worksheets("Форма"): Set sh3 = Worksheets("Разное")
lr = sh2.Cells(Rows.Count, 2).End(xlUp).Row
k = Application.WorksheetFunction.CountIf(sh.Columns(1), sh3.Range("B2"))
Set cell = sh.Columns(1).Find(sh3.Range("B2"))
For r2 = 7 To lr
    For r = cell.Row To cell.Row + k - 1
        If sh2.Cells(r2, 2) = sh.Cells(r, 9) Then
            If x = "" Then
                x = sh.Cells(r, 10)
            Else
                x = x & " " & sh.Cells(r, 10)
            End If
        End If
    Next r
    sh2.Cells(r2, 6) = x
    x = ""
Next r2
End Sub

работает! спасибо!

возможно в макрос добавитьусловие, при котором заполнение серийных номеров для определенных кодов не требуется?
например, для кода "код23" заполнять серийники в форму не требуется даже если они есть.
Изменено: Сергей Алешин - 12.02.2021 11:10:41
 
 
 
#15
11.02.2021 17:48:10
Сергей Алешин,  отредактируйте код выделив его и нажав на кнопку как на скрине...

можно как вариант
Код
Sub mrshkei()
Dim r As Long, r2 As Long, lr As Long, cell As Range, k As Long, sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Серийные номера"): Set sh2 = Worksheets("Форма"): Set sh3 = Worksheets("Разное")
lr = sh2.Cells(Rows.Count, 2).End(xlUp).Row
k = Application.WorksheetFunction.CountIf(sh.Columns(1), sh3.Range("B2"))
Set cell = sh.Columns(1).Find(sh3.Range("B2"))
For r2 = 7 To lr
If sh2.Cells(r2, 2) <> "код23" Then
    For r = cell.Row To cell.Row + k - 1
    
        If sh2.Cells(r2, 2) = sh.Cells(r, 9) Then
            If x = "" Then
                x = sh.Cells(r, 10)
            Else
                x = x & " " & sh.Cells(r, 10)
            End If
        End If
    Next r
    sh2.Cells(r2, 6) = x
    x = ""
    End If
Next r2
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#16
12.02.2021 12:32:15
Цитата
Mershik написал:
можно как вариант
Код
Sub mrshkei()
Dim r As Long, r2 As Long, lr As Long, cell As Range, k As Long, sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Серийные номера"): Set sh2 = Worksheets("Форма"): Set sh3 = Worksheets("Разное")
lr = sh2.Cells(Rows.Count, 2).End(xlUp).Row
k = Application.WorksheetFunction.CountIf(sh.Columns(1), sh3.Range("B2"))
Set cell = sh.Columns(1).Find(sh3.Range("B2"))
For r2 = 7 To lr
If sh2.Cells(r2, 2) <> "код23" Then
    For r = cell.Row To cell.Row + k - 1
     
        If sh2.Cells(r2, 2) = sh.Cells(r, 9) Then
            If x = "" Then
                x = sh.Cells(r, 10)
            Else
                x = x & " " & sh.Cells(r, 10)
            End If
        End If
    Next r
    sh2.Cells(r2, 6) = x
    x = ""
    End If
Next r2
End Sub

в первый раз выдало ошибку:
If sh2.Cells(r2, 2) = sh.Cells(r, 9) Then
вроде бы ничего не менял и само собой заработало.
Но! в моей книге работать не хочет, выдает такую же ошибку, хотя названия вкладок я изменил в полном соответсвии и расположение
ячеек и столбцов у меня такое же. Если навести курсор, то выдает ошибку sh.Cells(r, 9) = Error 2042.
не подскажете в чем может быть проблема?

Update:
вопрос решен, заменил в столбце #N/A на выдуманный код и заработало.
Изменено: Сергей Алешин - 12.02.2021 12:36:54
 
 
 
#17
12.02.2021 12:33:30
Сергей Алешин, без файла - вряд ли смогу помочь покажите с названиями Ваших актуальных листов (ненужный скройте или удалите)
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#18
12.02.2021 12:34:47
Проверьте, чему равна r при ошибке.
Возможно, в ячейке ошибка
 
 
 
#19
12.02.2021 12:38:13
вопрос решен, заменил в столбце #N/A на выдуманный код и заработало.
премного благодарен!!!

Цитата
vikttur написал:
Проверьте, чему равна r при ошибке.
не знаю как проверить к сожалению.
 
 
 
#20
12.02.2021 17:43:56
Цитата
Mershik написал:
Код
If sh2.Cells(r2, 2) <> "код23" Then    
For r = cell.Row To cell.Row + k - 1
подскажите, пожалуйста, как правильно добавить несколько исключений в дополнение к "код 23",
например:
"код 24", "код 77" и т.д.

я пытался через запятые, and, or, но не получается. гугол не помог тоже..
Изменено: Сергей Алешин - 12.02.2021 17:44:12
 
 
 
#21
12.02.2021 17:48:10
Код
If sh2.Cells(r2, 2) <> "код23" And sh2.Cells(r2, 2) <> "код24" And sh2.Cells(r2, 2) <> "код77" Then
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#22
12.02.2021 18:14:25
Jack Famous,

да-да, нашел отличную статью Проверка условий (If…Then…) и решил задачу.
но вам спасибо что откликнулись!
 
 
 
Страницы: 1
Наверх