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

Вход

Регистрация

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

 

= Мир MS Excel/Добавление дополнительного артикула - Мир MS Excel

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

Excel 2007
Добрый день коллеги,

добрался до макросов, написал как смог только для 1 позиции, а теперь задался вопросом а можно как-то дописать макрос так что бы была возможность добавлять дополнительные артикулы, которые должны работать по той же логике, что и первый артикул.

Я в макросах ноль тотальный, читал формулы искал в интернете что-то, кое как разобрался, а как дописать не получается, не могу построить правильно алгоритм

[vba]
Код

Private Sub worksheet_change(ByVal target As Excel.Range)

If Not Intersect(target, Range("B2")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("3:6").Hidden = True
            ElseIf target.Value = "Новый" Then
                .Rows("3:4").Hidden = False
                .Rows("5:6").Hidden = True
            ElseIf target.Value = "Существующий" Then
                .Rows("3:4").Hidden = True
                .Rows("5:6").Hidden = False
            End If
        End With
    End If
End Sub
[/vba]

Я понимаю, что таких будет 3 куска с рзличными строками. А как их объединить что бы они все 3 работали од первого условия, вот что непонятно. И плюс если в 1 условии будет скрыты строки, то после выбора 2 условия они не открываются...
К сообщению приложен файл: Task1.xlsm(15.2 Kb)


Сообщение отредактировал Gopronotmore - Среда, 06.06.2018, 16:08
 
Ответить
СообщениеДобрый день коллеги,

добрался до макросов, написал как смог только для 1 позиции, а теперь задался вопросом а можно как-то дописать макрос так что бы была возможность добавлять дополнительные артикулы, которые должны работать по той же логике, что и первый артикул.

Я в макросах ноль тотальный, читал формулы искал в интернете что-то, кое как разобрался, а как дописать не получается, не могу построить правильно алгоритм

[vba]
Код

Private Sub worksheet_change(ByVal target As Excel.Range)

If Not Intersect(target, Range("B2")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("3:6").Hidden = True
            ElseIf target.Value = "Новый" Then
                .Rows("3:4").Hidden = False
                .Rows("5:6").Hidden = True
            ElseIf target.Value = "Существующий" Then
                .Rows("3:4").Hidden = True
                .Rows("5:6").Hidden = False
            End If
        End With
    End If
End Sub
[/vba]

Я понимаю, что таких будет 3 куска с рзличными строками. А как их объединить что бы они все 3 работали од первого условия, вот что непонятно. И плюс если в 1 условии будет скрыты строки, то после выбора 2 условия они не открываются...

Автор - Gopronotmore
Дата добавления - 06.06.2018 в 12:56
Gopronotmore Дата: Среда, 06.06.2018, 16:14 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Отвечу сам себе

[vba]
Код

If Not Intersect(target, Range("A1")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "1" Then
                .Rows("7").Hidden = True
                .Rows("12").Hidden = True
            ElseIf target.Value = "2" Then
                .Rows("7").Hidden = False
                .Rows("12").Hidden = True
            ElseIf target.Value = "3" Then
                .Rows("7").Hidden = False
                .Rows("12").Hidden = False
            End If
        End With
    End If
If Not Intersect(target, Range("B2")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("3:6").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("3:4").Hidden = False
                .Rows("5:6").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("3:4").Hidden = True
                .Rows("5:6").Hidden = False
            End If
        End With
    End If
    
    If Not Intersect(target, Range("B7")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("8:11").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("8:9").Hidden = False
                .Rows("10:11").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("8:9").Hidden = True
                .Rows("10:11").Hidden = False
            End If
        End With
    End If
    
        If Not Intersect(target, Range("B12")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("13:16").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("13:14").Hidden = False
                .Rows("15:16").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("13:14").Hidden = True
                .Rows("15:16").Hidden = False
            End If
        End With
    End If
[/vba]
 
Ответить
СообщениеОтвечу сам себе

[vba]
Код

If Not Intersect(target, Range("A1")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "1" Then
                .Rows("7").Hidden = True
                .Rows("12").Hidden = True
            ElseIf target.Value = "2" Then
                .Rows("7").Hidden = False
                .Rows("12").Hidden = True
            ElseIf target.Value = "3" Then
                .Rows("7").Hidden = False
                .Rows("12").Hidden = False
            End If
        End With
    End If
If Not Intersect(target, Range("B2")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("3:6").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("3:4").Hidden = False
                .Rows("5:6").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("3:4").Hidden = True
                .Rows("5:6").Hidden = False
            End If
        End With
    End If
    
    If Not Intersect(target, Range("B7")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("8:11").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("8:9").Hidden = False
                .Rows("10:11").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("8:9").Hidden = True
                .Rows("10:11").Hidden = False
            End If
        End With
    End If
    
        If Not Intersect(target, Range("B12")) Is Nothing Then
        With Sheets("Sheet1")
            If target.Value = "" Then
                .Rows("13:16").Hidden = True
            ElseIf target.Value = "Íîâûé" Then
                .Rows("13:14").Hidden = False
                .Rows("15:16").Hidden = True
            ElseIf target.Value = "Ñóùåñòâóþùèé" Then
                .Rows("13:14").Hidden = True
                .Rows("15:16").Hidden = False
            End If
        End With
    End If
[/vba]

Автор - Gopronotmore
Дата добавления - 06.06.2018 в 16:14
sboy Дата: Среда, 06.06.2018, 16:28 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2013
Репутация: 576 ±
Замечаний: 0% ±

Excel 2010
вот такой вариант, если правильно понял задачу
[vba]
Код
Private Sub worksheet_change(ByVal target As Excel.Range)
Application.ScreenUpdating = False
If target.Address = "$A$1" Or target.Address = "$B$2" Then
    If [a1] = "" Then Exit Sub
    If [a1] > 0 Then
        Set arr_new = Rows("3:4")
        Set arr_exists = Rows("5:6")
            If [a1] > 1 Then
                Set arr_new = Union(arr_new, Rows("8:9"))
                Set arr_exists = Union(arr_exists, Rows("10:11"))
                    If [a1] = 3 Then
                        Set arr_new = Union(arr_new, Rows("13:14"))
                        Set arr_exists = Union(arr_exists, Rows("15:16"))
                    Else
                        Rows("13:16").Hidden = True
                    End If
            Else
                Rows("8:11").Hidden = True
                Rows("13:16").Hidden = True
            End If
    End If
    Select Case [b2]
    Case "Новый"
        arr_new.EntireRow.Hidden = False
        arr_exists.EntireRow.Hidden = True
    Case "Существующий"
        arr_new.EntireRow.Hidden = True
        arr_exists.EntireRow.Hidden = False
    End Select
End If
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 4521786.xlsm(17.7 Kb)
 
Ответить
Сообщениевот такой вариант, если правильно понял задачу
[vba]
Код
Private Sub worksheet_change(ByVal target As Excel.Range)
Application.ScreenUpdating = False
If target.Address = "$A$1" Or target.Address = "$B$2" Then
    If [a1] = "" Then Exit Sub
    If [a1] > 0 Then
        Set arr_new = Rows("3:4")
        Set arr_exists = Rows("5:6")
            If [a1] > 1 Then
                Set arr_new = Union(arr_new, Rows("8:9"))
                Set arr_exists = Union(arr_exists, Rows("10:11"))
                    If [a1] = 3 Then
                        Set arr_new = Union(arr_new, Rows("13:14"))
                        Set arr_exists = Union(arr_exists, Rows("15:16"))
                    Else
                        Rows("13:16").Hidden = True
                    End If
            Else
                Rows("8:11").Hidden = True
                Rows("13:16").Hidden = True
            End If
    End If
    Select Case [b2]
    Case "Новый"
        arr_new.EntireRow.Hidden = False
        arr_exists.EntireRow.Hidden = True
    Case "Существующий"
        arr_new.EntireRow.Hidden = True
        arr_exists.EntireRow.Hidden = False
    End Select
End If
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - sboy
Дата добавления - 06.06.2018 в 16:28
Gopronotmore Дата: Четверг, 07.06.2018, 09:26 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Спасибо большое!
 
Ответить
СообщениеСпасибо большое!

Автор - Gopronotmore
Дата добавления - 07.06.2018 в 09:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление дополнительного артикула (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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