Появление "выбиратора" исходя из условий - Страница 2 - Мир MS Excel

Регистрация

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

= Мир MS Excel/Появление "выбиратора" исходя из условий - Страница 2 - Мир MS Excel

Старая форма входа

Страница 2 из 2 « 1 2
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Появление "выбиратора" исходя из условий (Макросы/Sub)

Появление "выбиратора" исходя из условий

Дата: Среда, 13.06.2018, 10:20 | Сообщение № 21

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim i As Long, rw As Long, j As Long
   Dim Arr() As String
   Dim col As Collection

   If Target.Cells.Count = 1 Then
      If Target.Column = 3 And Target.Value = "Склад" Then
         With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
               .Clear
               .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
               .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
            End With
         End With
         i = Target.Row
         Cells(i, 5).Validation.Delete
         Err.Clear
         On Error Resume Next
         rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
         If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
               Set col = New Collection
               Do
                  col.Add Cells(rw, 10).Value
                  rw = rw + 1
               Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
               ReDim Arr(1 To col.Count)
               j = col.Count
               For j = 1 To col.Count
                  Arr(j) = col(j)
               Next j
               Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
               Cells(i, 5).Select
               Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
         End If
         Else
          If Target.Column = 3 And Target.Value = "Заказ" Then Cells(Target.Row, 5).Value = "-------------"
      End If
   End If

End Sub

[/vba]

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim i As Long, rw As Long, j As Long
   Dim Arr() As String
   Dim col As Collection

   If Target.Cells.Count = 1 Then
      If Target.Column = 3 And Target.Value = "Склад" Then
         With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
               .Clear
               .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
               .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
            End With
         End With
         i = Target.Row
         Cells(i, 5).Validation.Delete
         Err.Clear
         On Error Resume Next
         rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
         If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
               Set col = New Collection
               Do
                  col.Add Cells(rw, 10).Value
                  rw = rw + 1
               Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
               ReDim Arr(1 To col.Count)
               j = col.Count
               For j = 1 To col.Count
                  Arr(j) = col(j)
               Next j
               Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
               Cells(i, 5).Select
               Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
         End If
         Else
          If Target.Column = 3 And Target.Value = "Заказ" Then Cells(Target.Row, 5).Value = "-------------"
      End If
   End If

End Sub

[/vba]StoTisteg

К сообщению приложен файл: 5267853.xlsm (20.8 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Среда, 13.06.2018, 10:21

Ответить

Сообщение[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim i As Long, rw As Long, j As Long
   Dim Arr() As String
   Dim col As Collection

   If Target.Cells.Count = 1 Then
      If Target.Column = 3 And Target.Value = "Склад" Then
         With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
               .Clear
               .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
               .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
            End With
         End With
         i = Target.Row
         Cells(i, 5).Validation.Delete
         Err.Clear
         On Error Resume Next
         rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
         If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
               Set col = New Collection
               Do
                  col.Add Cells(rw, 10).Value
                  rw = rw + 1
               Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
               ReDim Arr(1 To col.Count)
               j = col.Count
               For j = 1 To col.Count
                  Arr(j) = col(j)
               Next j
               Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
               Cells(i, 5).Select
               Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
         End If
         Else
          If Target.Column = 3 And Target.Value = "Заказ" Then Cells(Target.Row, 5).Value = "-------------"
      End If
   End If

End Sub

[/vba]

Автор - StoTisteg
Дата добавления - 13.06.2018 в 10:20

Дата: Среда, 13.06.2018, 11:13 | Сообщение № 22

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

StoTisteg, Простите, я не знал, как нужно идентифицировать ошибку.
Если я выбираю "Заказ", то ячейка не чистится полностью. Там просто появляется "--------------", а "выбиратор" все еще сидит внутри. Это касается только тех ячеек где несколько поставщиков, например, "Вата (нест. 100 г.)"

Сообщение отредактировал AVI - Среда, 13.06.2018, 11:30

Ответить

Дата: Среда, 13.06.2018, 11:56 | Сообщение № 23

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Да, забыл, прошу пардону.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, rw As Long, j As Long
Dim Arr() As String
Dim col As Collection

If Target.Cells.Count = 1 Then
    If Target.Column = 3 And Target.Value = "Склад" Then
        With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
            .Clear
            .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            End With
        End With
        i = Target.Row
        Cells(i, 5).Validation.Delete
        Err.Clear
        On Error Resume Next
        rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
        If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
            Set col = New Collection
            Do
                col.Add Cells(rw, 10).Value
                rw = rw + 1
            Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
            ReDim Arr(1 To col.Count)
            j = col.Count
            For j = 1 To col.Count
                Arr(j) = col(j)
            Next j
            Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
            Cells(i, 5).Select
            Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
        End If
        Else
        If Target.Column = 3 And Target.Value = "Заказ" Then
            With Cells(Target.Row, 5)
                 .Value = "-------------"
                 .Validation.Delete
           End With
       End If
    End If
End If

End Sub

[/vba]

Да, забыл, прошу пардону.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, rw As Long, j As Long
Dim Arr() As String
Dim col As Collection

If Target.Cells.Count = 1 Then
    If Target.Column = 3 And Target.Value = "Склад" Then
        With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
            .Clear
            .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            End With
        End With
        i = Target.Row
        Cells(i, 5).Validation.Delete
        Err.Clear
        On Error Resume Next
        rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
        If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
            Set col = New Collection
            Do
                col.Add Cells(rw, 10).Value
                rw = rw + 1
            Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
            ReDim Arr(1 To col.Count)
            j = col.Count
            For j = 1 To col.Count
                Arr(j) = col(j)
            Next j
            Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
            Cells(i, 5).Select
            Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
        End If
        Else
        If Target.Column = 3 And Target.Value = "Заказ" Then
            With Cells(Target.Row, 5)
                 .Value = "-------------"
                 .Validation.Delete
           End With
       End If
    End If
End If

End Sub

[/vba]StoTisteg

К сообщению приложен файл: 3896484.xlsm (21.0 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Среда, 13.06.2018, 11:59

Ответить

СообщениеДа, забыл, прошу пардону.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long, rw As Long, j As Long
Dim Arr() As String
Dim col As Collection

If Target.Cells.Count = 1 Then
    If Target.Column = 3 And Target.Value = "Склад" Then
        With ActiveSheet
            With .ListObjects("Таблица2").Sort.SortFields
            .Clear
            .Add Key:=Range("Таблица2[[#All],[Наименование]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With
            With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            End With
        End With
        i = Target.Row
        Cells(i, 5).Validation.Delete
        Err.Clear
        On Error Resume Next
        rw = Columns(8).Find(what:=Cells(i, 2).Value).Row
        If Err.Number = 0 Then
            If Cells(rw, 8).Value = Cells(rw + 1, 8).Value Then
            Set col = New Collection
            Do
                col.Add Cells(rw, 10).Value
                rw = rw + 1
            Loop While Cells(rw, 8).Value = Cells(rw - 1, 8).Value
            ReDim Arr(1 To col.Count)
            j = col.Count
            For j = 1 To col.Count
                Arr(j) = col(j)
            Next j
            Cells(i, 5).Validation.Add Type:=xlValidateList, Formula1:=Join(Arr, ",")
            Cells(i, 5).Select
            Else: Cells(i, 5).Value = Cells(rw, 10).Value
            End If
        End If
        Else
        If Target.Column = 3 And Target.Value = "Заказ" Then
            With Cells(Target.Row, 5)
                 .Value = "-------------"
                 .Validation.Delete
           End With
       End If
    End If
End If

End Sub

[/vba]

Автор - StoTisteg
Дата добавления - 13.06.2018 в 11:56

Дата: Среда, 13.06.2018, 16:52 | Сообщение № 24

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

StoTisteg, Подскажите, пожалуйста, а что это за единички появились в столбце А?

Ответить

Дата: Пятница, 06.07.2018, 06:47 | Сообщение № 25

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Выбрал Ваш вариант, так как хоть как-то в нем могу разобраться при переносе в большой рабочий файл. Но получилось только в первой строке, яе понимаю как заставить массив работать для последующих строк. Выбор строки для работы массивной формулы происходит макросом?
Подскажите, пожалуйста, как заставить работать массивную формулу при выборе данных в остальных строках

К сообщению приложен файл: ___1.2.1.xlsm (49.2 Kb)

Ответить

Дата: Пятница, 06.07.2018, 09:52 | Сообщение № 26

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

ВЫ макрос засунули не на тот лист. Ну и по мелочи еще там еще и Ваше поправил, и свое дополнил

К сообщению приложен файл: _1.2.1_1.xlsm (50.9 Kb)

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

Ответить

Дата: Пятница, 06.07.2018, 10:27 | Сообщение № 27

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Блин, спасибо... Невнимательно поступил.

Ответить

Дата: Пятница, 06.07.2018, 11:16 | Сообщение № 28

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Наткнулся на такую штуку. Макрос срабатывает, когда я выбираю ячейку, но если случайно выбрать уже заполненную, что оттуда все стирается. Можно предусмотреть, что бы, например, выбор поставщика (а равно как и срабатывание макроса) происходило только после того как я изменю ячейку «операции»? То есть макрос срабатывал при двух условиях: сначала должен быть Worksheet_Change поле «операции» , а потом Worksheet_SelectionChange соответствующей ячейки. Я понимаю какие команды нужно использовать, но не знаю как из связать…

Ответить

Дата: Пятница, 06.07.2018, 11:20 | Сообщение № 29

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Цитата AVI, 06.07.2018 в 11:16, в сообщении № 28 ()

но если случайно выбрать уже заполненную, что оттуда все стирается

Нет такого в макросе. Покажите на примере

Цитата AVI, 06.07.2018 в 11:16, в сообщении № 28 ()

сначала должен быть Worksheet_Change поле «операции» , а потом Worksheet_SelectionChange соответствующей ячейки

Ага, а если сначала изменили операцию, потом ткнулись еще в пару ячеек, а потом только в выбор поставщика? Как тогда? Не, можно конечно глобальную переменную сделать или на листе писать, но это не очень хорошо

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

Ответить

Дата: Пятница, 06.07.2018, 17:18 | Сообщение № 30

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

Цитата _Boroda_, 06.07.2018 в 11:20, в сообщении № 29 ()

Нет такого в макросе. Покажите на примере

Простите! Очень странно. На другом компьютере исчезало. Дома открываю все на месте...

И надеюсь, последний вопрос.

В столбец "P" выгружаются договоры с нулевым остатком. А можно сделать так что бы массив игнорировал такие, то есть отображал только те, где остаток больше нуля?

К сообщению приложен файл: __0.xlsm (93.3 Kb)

Сообщение отредактировал AVI - Пятница, 06.07.2018, 17:23

Ответить

Дата: Пятница, 06.07.2018, 18:11 | Сообщение № 31

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Чуть формулу поменять нужно

К сообщению приложен файл: _01.xlsb (65.7 Kb)

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

Ответить

Дата: Суббота, 07.07.2018, 06:10 | Сообщение № 32

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Спасибо, помогло!

Но. Опять

Цитата AVI, 06.07.2018 в 11:16, в сообщении № 28 ()

но если случайно выбрать уже заполненную, что оттуда все стирается

Попробовал с двух компьютеров. Все одинаково. Если в открывшемся файле просто стрелкой поднять выделение на заполненную ячейку, то данные оттуда стираются.

К сообщению приложен файл: 5823385.xlsm (95.2 Kb)

Ответить

Дата: Суббота, 07.07.2018, 07:31 | Сообщение № 33

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Они не стираются, а перезаписываюся на данные из Р1. Зачем, сие есть тайна.

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Суббота, 07.07.2018, 16:44 | Сообщение № 34

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

AVI, у меня в файле список в каком столбце? В Р. А у Вас в каком? В Q. Зачем переместили? Вот и ответ на

Цитата RAN, 07.07.2018 в 07:31, в сообщении № 33 ()

Зачем, сие есть тайна.

Если список переместили, то и в макросе перепишите

К сообщению приложен файл: 5823385_1.xlsb (65.7 Kb)

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

Ответить

Дата: Среда, 11.07.2018, 06:02 | Сообщение № 35

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Да, что-то я совсем затупил...

Опять вопрос по формуле
Массивная

Код

=ЕСЛИ(Опер<>"Заказано у поставщика";;ЕСЛИОШИБКА(ИНДЕКС(Договоры_tb[Поставщик];НАИМЕНЬШИЙ(ЕСЛИ((Договоры_tb[Наименование]=Наим)*Договоры_tb[Остаток];СТРОКА(Договоры_tb[Наименование])-СТРОКА(Договоры_tb[[#Заголовки];[Наименование]]));СТРОКА()));))

Мне нужно добавить еще условие
Помимо

Код

Опер<>"Заказано у поставщика"

должно быть еще

Код

Опер<>"Получено от поставщика"

Но если в обычное "Если" можно добавить "Или", то в массивную оно не получается…

Сообщение отредактировал AVI - Среда, 11.07.2018, 06:03

Ответить

Дата: Среда, 11.07.2018, 09:35 | Сообщение № 36

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

В данном случае (когда неравенство) нужно не ИЛИ, а И
[vba]

Код

=ЕСЛИ((Опер<>"Заказано у поставщика")*(Опер<>"Получено от поставщика");;ЕСЛИОШИБКА(ИНДЕКС(Договоры_tb[Поставщик];НАИМЕНЬШИЙ(ЕСЛИ((Договоры_tb[Наименование]=Наим)*Договоры_tb[Остаток];СТРОКА(Договоры_tb[Наименование])-СТРОКА(Договоры_tb[[#Заголовки];[Наименование]]));СТРОКА()));

[/vba]))

К сообщению приложен файл: 5823385_2.xlsb (66.1 Kb)

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

Ответить

Дата: Среда, 11.07.2018, 16:56 | Сообщение № 37

Группа: Проверенные

Ранг: Ветеран

Сообщений: 523

Репутация: 17 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, Блин, я почему-то подумал, что если эти условия перемножить, то формула будет искать нахождение и первого и второго условия одновременно и даже не стал пробовать, а надо было бы...

Ответить

Дата: Среда, 11.07.2018, 23:02 | Сообщение № 38

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Цитата AVI, 11.07.2018 в 16:56, в сообщении № 37 ()

формула будет искать нахождение и первого и второго условия

Забыли 2 буквы - "формула будет искать НЕнахождение и первого и второго условия". А нам того и нужно

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

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Появление "выбиратора" исходя из условий (Макросы/Sub)

Страница 2 из 2
«
1
2

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