Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA два массива в автофильтр умной таблицы, задаю 2 критерия, массивами, получаю ошибку 1004
 
#1
03.05.2017 07:23:35
Привет всем кодоводам!
Есть умная таблица (не однородная) с заголовками внутри. Создаю форму с 2 Mountview в которых выбираю даты и записываю их в ячейки К2,К3
Код
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)

    Range("k2").Select
    Selection.NumberFormat = "mm\/dd\/yyyy"
    ActiveCell.FormulaR1C1 = MonthView1.Value

End Sub
, а в ячейке К4 вычисляю интервал между ними. (K3-K2)
В ячейки L1:L100 записываются все даты в выбранном ранее интервале.
Записываю массив с полученным интервалом дат:
Код
Public myArrr(1000, 0) As Variant
Sub макрос_запись_в_массив()
Application.ScreenUpdating = False
    ActiveSheet.ListObjects("Таблица10").Range.AutoFilter Field:=2
kol = Range("K4").Value 'присваиваю количество дней между датами
Range("L1:M999").Clear   'очищаю дату из интервала дат
Range("L1").Value = Range("K2").Value 
Range("L1").Select  'выделяю первую дату в интервале
Selection.AutoFill Destination:=Range(Cells(1, 12), Cells(kol + 1, 12)), Type:=xlFillDefault 
'получаю все даты в выбранном интервале
Range("M1:M150").NumberFormat = "mm\/dd\/yyyy"
Макрос_Запись_данных_в_массив
макрос_фильтра
Application.ScreenUpdating = True
End Sub
Записываю даты в массив:
Код
For i = 0 To 100
    If Range("l" & i + 1).Value <> "" Then
     myArrr(i, 0) = Range("l" & i + 1).Value
End If
Next
В первый критерий я записываю массив с названиями заголовков, а во второй массив интервал дат.
Код
ActiveSheet.ListObjects("Таблица10").Range.AutoFilter _
    Field:=2, _
    Criteria1:=Array("Время пожара", "Время происшествия", "Время ЧС", "Дата", "Штормовые"), _
    Operator:=xlFilterValues, _
    Criteria2:=myArrr 'Выдает ошибку run-time 1004 error
Нужно отфильтровать по датам и при этом оставить строки заголовков.
Где и что у меня не так?
Excel 2010.
Изменено: Chimichangi - 03.05.2017 07:59:53
 
 
 
#2
03.05.2017 08:37:13
Вы пытаетесь в критерии впихнуть 2 массива подразумевая оператор И, но вписав оператор xlFilterValues. Вот это и
Цитата
Chimichangi написал:
что у меня не так
. Кто Вам мешает собрать все нужные значения в один массив?
Я сам - дурнее всякого примера! ...
 
 
 
#3
03.05.2017 09:39:52
Собрал в один массив. Зависает сам Excel... (Лист Microsoft Excel (2).xlsm)
Код
ActiveSheet.ListObjects("Таблица10").Range.AutoFilter _
    Field:=2, _
    Criteria1:=myArrr, Operator:=xlFilterValues
Если пишу:
Код
ActiveSheet.ListObjects("Таблица10").Range.AutoFilter _
    Field:=2, _
    Criteria1:=myArrr, _
    Operator:=xlAnd, _
    Criteria2:=Array("Время пожара", "Время происшествия", "Время ЧС", "Дата", "Штормовые")
Получаю пустой список. (Лист Microsoft Excel.xlsm)
 
 
 
#4
03.05.2017 13:04:45
Цитата
Chimichangi написал:
Собрал в один массив. Зависает сам Excel
А посмотреть что в Вашем массиве? Массив д.б. одномерным.
Так работает:
Код
Public myArrr(1000) As Variant

Sub Макрос_Запись_данных_в_массив()
For i = 0 To 1000
    If Range("l" & i + 1).Value <> "" Then
     myArrr(i) = Range("l" & i + 1).Value
End If
Next
Range("M1").Resize(1000, 1).Value = myArrr 'смотрю что в массиве
макрос_фильтра
End Sub

И еще, я бы не объявлял сразу размерность, а вычислял бы ее по ходу. И присваивал через Redim.
Я сам - дурнее всякого примера! ...
 
 
 
#5
04.05.2017 06:13:22
Большое спасибо!
Сделал как вы сказали:
сделал динамический массив и стал указывать количество элементов в нем, по ходу.
Код
Public myArrr() As Variant, size As Integer, i As Integer

Sub Макрос_Запись_данных_в_массив()
size = Range("K4").Value 'количество ячеек в столбце L считаю как разность 2 ячеек К3-К2 (разность между датами) и плюсую 4
ReDim myArrr(size) 'задаю размер массива
For i = 0 To size
    If Range("l" & i + 1).Value <> "" Then 'проверяю на пустошь смауга
    myArrr(i) = Range("l" & i + 1).Value 'присваиваю элементу массива, значения. Значения названия и даты правильные
End If
Next
Range("M1").Resize(size, 1).Value = myArrr() 'смотрю что в массиве

макрос_фильтра
End Sub
Есть прогресс, начало показывать заголовки, но не показывает самое важное - строки с датами.
Смотрю поэтапно (F8) значения показывает правильные:
Код
Range("l" & i + 1).Value 'В этой строчке, все как положено - названия и даты
А при просмотре, что записано в массив, выдает лишь первое значение.  Как так-то?

Кто подскажет, где собака зарыта?
 
 
 
#6
04.05.2017 07:23:21
Цитата
Chimichangi написал:
не показывает самое важное - строки с датами
И не будет. В таблице у Вас дата и время, а в массиве только дата. Для экса это разные числа. Дата - целое, время целое с дробной частью.
Я сам - дурнее всякого примера! ...
 
 
 
#7
04.05.2017 08:15:00
Попробуйте так, вместо всех Ваших макросов:
Код
Sub MyFilter()
    Dim n&, c As Range, i&
    ReDim myarr(1 To Range("b9:B" & Cells(Rows.Count, 2).End(xlUp).Row).Cells.Count)    'задаю размер массива
    For Each c In Range("b9:B" & Cells(Rows.Count, 2).End(xlUp).Row).Cells
        If IsDate(c) Then
            If c.Value >= [k2] And c.Value <= [k3] Then
                n = n + 1: myarr(n) = c.Text
            End If
        End If
    Next
    For i = 1 To 4
        n = n + 1: myarr(n) = Cells(i, 12)
    Next
    ReDim Preserve myarr(1 To n)
    ActiveSheet.ListObjects("Таблица10").Range.AutoFilter 2, myarr, xlFilterValues
End Sub
Изменено: kuklp - 04.05.2017 08:16:13
Я сам - дурнее всякого примера! ...
 
 
 
#8
04.05.2017 08:53:44
Код
Sub макрос_фильтра()
'на активном листе в умной таблице задаю 2 критерия для фильтра: _
  первый критерий массив из значений _
  второй критерий массив дат
  Dim ar, arf, arff
  Dim dst As Date, dend As Date
  Dim i&, k&, n&
    dst = CDate("06.04.17")
    dend = CDate("01.05.17")
    With ActiveSheet.ListObjects("Таблица10")
        ar = .ListColumns(2).DataBodyRange.Value
        ReDim arf(0 To UBound(ar) - 1)
        With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            If Not IsDate(ar(i, 1)) Then
                arf(k) = ar(i, 1)
                k = k + 1
            Else
                If CDate(ar(i, 1)) <= dend Then
                    If CDate(ar(i, 1)) >= dst Then
                    .Item(Format(ar(i, 1), "mm\/dd\/yyyy")) = 1
                   End If
                End If
            End If
        Next
         ReDim Preserve arf(0 To k - 1)
         arff = .keys
         End With
         ReDim ar(0 To UBound(arff) * 2 + 1)
         For i = 0 To UBound(ar)
         ar(i) = IIf(i Mod 2, arff(i \ 2), 2)
         Next
.Range.AutoFilter _
            Field:=2, _
            Criteria1:=arf, Operator:=xlFilterValues, Criteria2:=ar
    End With
End Sub
 
 
 
#9
04.05.2017 12:02:03
kuklp и RAN огромнейшее Вам спасибо за помощь!
 
 
 
Страницы: 1
Наверх