Доброго времени! Хочу попросить помочь поправить код, который исходя из условий дата и значение из списка1 если стоит галочка и из списка 2 (если нет галочки) выбирает значения. Код работает, но нужно еще чтобы если указана дата, но не выбрано значение из списка 1 или 2 (ячейка со значением пуста) фильтр выводил все значения за указанную дату. Вот код [vba]
Код
Sub ChoiceOfData2() Dim ArrData, ArrRes Dim dtDateS As Date, dtDateF As Date Dim sObj As String, bGroup As Boolean Dim lRws As Long Dim i As Long, k As Long With wsKt lRws = .Cells(.Rows.Count, 5).End(xlUp).Row If lRws < 5 Then Exit Sub ArrData = .Range("E5:I" & lRws).Value ' расход End With
With wsAnalytic sObj = .Cells(4, 13).Value dtDateS = .Cells(2, 12).Value: dtDateF = .Cells(4, 12).Value bGroup = .Cells(2, 14).Value End With
If dtDateF = 0 Then dtDateF = 100000 ' если нет конечной даты lRws = UBound(ArrData): ReDim ArrRes(1 To lRws, 1 To 5)
For i = 1 To lRws If ArrData(i, 1) >= dtDateS Then If ArrData(i, 1) <= dtDateF Then If bGroup Then ' группа статей If Replace(UCase(ArrData(i, 5)), UCase(sObj), "") = _ UCase(ArrData(i, 5)) Then GoTo AA Else ' статья If ArrData(i, 3) <> sObj Then GoTo AA End If
k = k + 1 ArrRes(k, 1) = ArrData(i, 1) ArrRes(k, 2) = ArrData(i, 2) ArrRes(k, 3) = ArrData(i, 3) ArrRes(k, 4) = ArrData(i, 4) ArrRes(k, 5) = ArrData(i, 5) End If End If AA: Next i
If k > 0 Then wsAnalytic.Cells(7, 12).Resize(k, 5).Value = ArrRes End Sub
[/vba]
[moder]Переназовите тему более конкретно и пример с Вашими данными покажите.[/moder]
Доброго времени! Хочу попросить помочь поправить код, который исходя из условий дата и значение из списка1 если стоит галочка и из списка 2 (если нет галочки) выбирает значения. Код работает, но нужно еще чтобы если указана дата, но не выбрано значение из списка 1 или 2 (ячейка со значением пуста) фильтр выводил все значения за указанную дату. Вот код [vba]
Код
Sub ChoiceOfData2() Dim ArrData, ArrRes Dim dtDateS As Date, dtDateF As Date Dim sObj As String, bGroup As Boolean Dim lRws As Long Dim i As Long, k As Long With wsKt lRws = .Cells(.Rows.Count, 5).End(xlUp).Row If lRws < 5 Then Exit Sub ArrData = .Range("E5:I" & lRws).Value ' расход End With
With wsAnalytic sObj = .Cells(4, 13).Value dtDateS = .Cells(2, 12).Value: dtDateF = .Cells(4, 12).Value bGroup = .Cells(2, 14).Value End With
If dtDateF = 0 Then dtDateF = 100000 ' если нет конечной даты lRws = UBound(ArrData): ReDim ArrRes(1 To lRws, 1 To 5)
For i = 1 To lRws If ArrData(i, 1) >= dtDateS Then If ArrData(i, 1) <= dtDateF Then If bGroup Then ' группа статей If Replace(UCase(ArrData(i, 5)), UCase(sObj), "") = _ UCase(ArrData(i, 5)) Then GoTo AA Else ' статья If ArrData(i, 3) <> sObj Then GoTo AA End If
k = k + 1 ArrRes(k, 1) = ArrData(i, 1) ArrRes(k, 2) = ArrData(i, 2) ArrRes(k, 3) = ArrData(i, 3) ArrRes(k, 4) = ArrData(i, 4) ArrRes(k, 5) = ArrData(i, 5) End If End If AA: Next i
If k > 0 Then wsAnalytic.Cells(7, 12).Resize(k, 5).Value = ArrRes End Sub
[/vba]
[moder]Переназовите тему более конкретно и пример с Вашими данными покажите.[/moder]Marisa
Сообщение отредактировал Marisa - Среда, 30.03.2016, 10:57
Manyasha, Спасибо огромное, что помогли мне в который раз! По поводу
Цитата
для переменной bGroup наверное надо значение чекбокса брать?
, я вставляла столбцы и этот момент проворонила. Еще раз СПАСИБО! [moder]Для цитат есть своя кнопка (слева от fx). Или можно выделить нужный текст и нажать "Цитата" под сообщением[/moder]
Manyasha, Спасибо огромное, что помогли мне в который раз! По поводу
Цитата
для переменной bGroup наверное надо значение чекбокса брать?
, я вставляла столбцы и этот момент проворонила. Еще раз СПАСИБО! [moder]Для цитат есть своя кнопка (слева от fx). Или можно выделить нужный текст и нажать "Цитата" под сообщением[/moder]Marisa
Сообщение отредактировал Manyasha - Среда, 30.03.2016, 12:49