Добавление дополнительного артикула

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление дополнительного артикула (Макросы/Sub)

Gopronotmore

Дата: Среда, 06.06.2018, 12:56 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 199

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

Замечаний: 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

Ответить

Gopronotmore

Дата: Среда, 06.06.2018, 16:14 | Сообщение № 2

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

Ранг: Форумчанин

Сообщений: 199

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

Замечаний: 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]

Код

[/vba]Gopronotmore

Ответить

СообщениеОтвечу сам себе

[vba]

Код

[/vba]

Автор - Gopronotmore
Дата добавления - 06.06.2018 в 16:14

sboy

Дата: Среда, 06.06.2018, 16:28 | Сообщение № 3

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

Ранг: Участник клуба

Сообщений: 2566

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

Замечаний: 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)

Яндекс: 410016850021169

Ответить

Gopronotmore

Дата: Четверг, 07.06.2018, 09:26 | Сообщение № 4

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

Ранг: Форумчанин

Сообщений: 199

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

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

Excel 2007

Спасибо большое!

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление дополнительного артикула (Макросы/Sub)

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