Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
сверка макросом
 
#1
18.08.2022 17:42:52
Добрый день.

Имеется задача : на 1м листе есть выпадающие списки со своим названием "главы", внутри которых свой перечень информации. на 2м листе этот перечень инфо из всех выпадающих списков прописывается в столбце А, а в столбцах В1,С1,D1 и тд названия этих глав.

Нужно чтобы при написании на листе 2 в столбец А одного из перечня этих инфо- он сравнивал в какой это главе имеется и ставил "х".
Проблема в том, что главы эти на разные кол-ва строк и так понимаю, что для каждой главы видимо придётся указывать промежуток полагаю...
Возможно были уже такие темы, но не увидел. Заранее спасибо.
Изменено: Lincoln13 - 18.08.2022 20:24:18
 
 
 
#2
18.08.2022 18:04:28
Цитата
Lincoln13 написал: сверка макросом
Что сверяем?
 
 
 
#3
18.08.2022 19:15:30
Цитата
написал:
Цитата
Lincoln13 написал: сверка макросом
Что сверяем?
Данные с листа 1 и 2
 
 
 
#4
18.08.2022 20:10:20
Что-то написался я сегодня макросов на работе, поэтому просто от чистого сердца, простыми словами как это можно сделать без макросов  :D
1. Нажмите на маленький квадратик с циферкой "1" в левом верхнем углу, см рисунок 1;
2. В ячейку B2 запишите формулу =A2 и копируем её, см. рисунок 2;
3. На вкладке ГЛАВНАЯ --> Найти и выделить --> Выделить группу ячеек... --> Только видимые --> ОК, см. рисунок 3;
4. Enter, у Вас должны вставиться формулы в эти ячейки;
5. Нажмите на маленький квадратик с циферкой "2" в левом верхнем углу
6. Выделяем данные таблицы, повторяем действия п.3, только вместо "Только видимые" выбираем "Пустые ячейки"
7. Жмём на "=" и потом стрелочку вверх, в верхней ячейке (В3) должна появиться формула =В2, после чего зажимаем CTRL + ENTER
8. На листе СВОД в ячейке B2 пишем формулу и протягиваем вправо и вниз
Код
=ЕСЛИОШИБКА(ЕСЛИ(ПОИСКПОЗ($A2&B$1;Список!$A$2:$A$24&Список!$B$2:$B$24;0)>0;"x";"");"")

PS: я добавил столбец после столбца А, перед скрытым столбцом, можете это сделать просто в свободном столбце
Изменено: Msi2102 - 18.08.2022 20:27:44
 
 
 
#5
19.08.2022 10:33:38
В модуль листа Свод
Код
Private Sub Worksheet_Activate()
    Range("A1").Value = Range("A1").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 1 Then
        Static dic As Object
        Dim yy As Long
        If Target.Address(0, 0) = "A1" Or dic Is Nothing Then
            Set dic = CreateObject("Scripting.Dictionary")
            dic.CompareMode = 1
            With Sheets("Список")
                yy = .Cells(.Rows.Count, 1).End(xlUp).Row
                If yy > 1 Then
                    Dim arr As Variant
                    arr = .Cells(1, 1).Resize(yy)
                    Dim vv As Variant
                    For yy = 1 To UBound(arr, 1)
                        If .Rows(yy).OutlineLevel = 1 Then vv = arr(yy, 1)
                        dic.Item(arr(yy, 1)) = vv
                    Next
                End If
            End With
        End If
        If dic.Exists(Target.Value) Then
            yy = 0
            On Error Resume Next
            yy = WorksheetFunction.Match(dic.Item(Target.Value), Rows(1), 0)
            On Error GoTo 0
            If yy > 1 Then
                Application.EnableEvents = False
                Cells(Target.Row, yy).Value = "х"
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
Некритичные замечания. Вы неправильно используете термин "выпадающие списки". И в примере bbb на листе Свод относится к 1, а на листе Список находится под 3.
 
 
 
#6
19.08.2022 11:58:45
Lincoln13, Антиспам тошнит от Ваших цитат. Он скрывает сообщения по тому, что цитата должна быть к месту и не надо цитировать все подряд.
По вопросам из тем форума, личку не читаю.
 
 
 
#7
19.08.2022 12:17:06
МатросНаЗебре, Спасибо!
Единственное- можно попросить объяснить логику действий макроса? он останавливается на моменте  "If Target.Cells.Count > 1 Then Exit Sub" при его активации, не разберусь почему...
 
 
 
#8
19.08.2022 12:23:09
Lincoln13,  макрос обрабатывает изменение только одной ячейки. А если Target.Cells.Count > 1 тогда Exit Sub
 
 
 
#9
19.08.2022 12:32:04
В таком варианте будет работать и для более чем одной ячейки.
Код
Private Sub Worksheet_Activate()
    Range("A1").Value = Range("A1").Value
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rr As Range
    On Error Resume Next
    Set rr = Intersect(Target, ActiveSheet.UsedRange, Columns(1))
    On Error GoTo 0
    If Not rr Is Nothing Then
        Dim rTarget As Range
        Static dic As Object
        Dim yy As Long
        Dim arr As Variant
        Dim vv As Variant
        For Each rTarget In rr
            If rTarget.Address(0, 0) = "A1" Or dic Is Nothing Then
                Set dic = CreateObject("Scripting.Dictionary")
                dic.CompareMode = 1
                With Sheets("Список")
                    yy = .Cells(.Rows.Count, 1).End(xlUp).Row
                    If yy > 1 Then
                        arr = .Cells(1, 1).Resize(yy)
                        For yy = 1 To UBound(arr, 1)
                            If .Rows(yy).OutlineLevel = 1 Then vv = arr(yy, 1)
                            dic.Item(arr(yy, 1)) = vv
                        Next
                    End If
                End With
            End If
            If dic.Exists(rTarget.Value) Then
                yy = 0
                On Error Resume Next
                yy = WorksheetFunction.Match(dic.Item(rTarget.Value), Rows(1), 0)
                On Error GoTo 0
                If yy > 1 Then
                    Application.EnableEvents = False
                    Cells(rTarget.Row, yy).Value = "х"
                    Application.EnableEvents = True
                End If
            End If
        Next
    End If
End Sub
 
 
 
#10
19.08.2022 12:55:02
МатросНаЗебре, Спасибо.
Но без понимания алгоритма действий он у меня криво работает, заменяя на 2м листе данные в столбце А и не проставляет иксы при схожести в столбцах В,С и тд.
Буду искать разбор действий.
 
 
 
#11
22.08.2022 12:58:58
МатросНаЗебре, можно попросить Вас объяснить принцип его действий? я видимо рукожоп и у меня первая часть только работает макроса, а остальная для простановки "х" не работает... он же сверяет данные с 2х листов для простановки "х" в столбцах В,С и т.д.?
 
 
 
#12
22.08.2022 13:16:13
Работает так.
Вводите значение в первый столбец в строку больше 1.
Макрос ищет вводимое значение на листе Список.
Вверх от найденного значения ищет итоговою строку по группе. Запоминаем это значение.
Ищем это значение в первой строке на листе Свод.
В столбец, в котором нашли это значение, ставим x.
 
 
 
Страницы: 1
Наверх