Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/86: Рейтинг темы: голосов - 86, средняя оценка - 4.80
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
#1

фильтр (vba excel)

18.03.2011, 10:21. Просмотров 15745. Ответов 8
Метки нет (Все метки)

Делаю фильтр на табличку. В первоначальном задании было достаточно просто, т.к. все укладывалось в автофильтр (1 запись - 1 строка). Но вот тз изменилось и теперь в исходной табличке МОГУТ быть объединенные ячейки.

На скринах для примера привожу 1) Исходную таблицу, 2) Результат работы автофильтра по запросу ФИО = Сидоров
Т.е. по правильному мне надо результат - целиком набор строк, относящихся к Сидорову, но мне выдает только 1-ю строку.

Не подскажите решения? А то пока что у меня в голове куча FOR-ов, IF-ов и вобще 100500 раз проверка всех строк таблицы перебором
0
Миниатюры
фильтр (vba excel)   фильтр (vba excel)  
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.03.2011, 10:21
Ответы с готовыми решениями:

Vba excel windows и vba excel Mac Os - Макинтош корявит шрифт
Всем привет, столкнулся с такой ситуацией. Макросы написаны на Excel 2016...

Функциия excel в функции excel на vba
С помощью мастера записи матросов получил следующую функцию...

Формульный фильтр в Excel
Помогите. Нужно выбирать из диапазона данных, выстроенного столбиком,...

Сложный фильтр в MS Excel
Задача : 1. Фильтр : Фильтровать данные таким образом, чтобы было видно...

Фильтр через макросы (Excel)
Private Sub ComboBox1_Change() 'Range("D1").Select 'b = ComboBox1.Text ' ...

8
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
18.03.2011, 10:34  [ТС] #2
p.s. Результат фильтра должен формировать новую таблицу на другом листе (это если вдруг принципиально как выводить результаты)
0
Busine2009
Заблокирован
18.03.2011, 14:32 #3
Чтобы понять, о чём смысл, сделайте следующее:
  1. введите в ячейку A1 число 1; введите в ячейку A2 число 2;
  2. выделите ячейки B1:B2 - объедините их;
  3. скопируйте объединённые ячейки - выделите диапазон ячеек A1:A2 - щ. правой кн. мыши - Специальная вставка... - кружок Форматы - OK. В результате произошло объединение ячеек A1:A2, но если вы теперь уберёте объединение ячеек, то увидите, что данные в ячейках сохранены.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub P2()
Dim Лист1 As Excel.Worksheet
Dim Временный As Excel.Worksheet
Dim LastRow As Long
Dim LastColomn As Long
Dim oFind As Excel.Range
Dim АдресПоиск As String
Dim АдресОбъединённых As String
Set Лист1 = ActiveWorkbook.Worksheets("Лист1")
With Лист1.UsedRange
    LastRow = .Rows.Count
    LastColomn = .Columns.Count
End With
With Лист1.Range(Лист1.Cells(1, 1), Лист1.Cells(LastRow, LastColomn))
    Application.FindFormat.Clear
    Application.FindFormat.MergeCells = True
    Set oFind = .Find(what:="", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, Searchformat:=True)
    If Not oFind Is Nothing Then
        АдресПоиск = oFind.Address
        Set Временный = ActiveWorkbook.Worksheets.Add
        Do
            АдресОбъединённых = oFind.MergeArea.Address
            oFind.MergeArea.Copy
            Лист1.Paste Destination:=Временный.Range("A1")
            oFind.MergeArea.UnMerge
            Лист1.Range(АдресОбъединённых).Value = Временный.Range("A1")
            Временный.Range("A1").MergeArea.Copy
            oFind.PasteSpecial xlPasteFormats
            Временный.Cells.Clear
            Временный.Cells.UnMerge
            Set oFind = .Find(what:="", After:=oFind, Searchformat:=True)
        Loop While Not oFind Is Nothing And oFind.Address <> АдресПоиск
    End If
End With
Application.DisplayAlerts = False
Временный.Delete
Application.DisplayAlerts = True
Application.FindFormat.Clear
End Sub
1
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
18.03.2011, 14:52  [ТС] #4
спасибо большое!

p.s. заодно узнал, что для определения последних строк и столбцов необязательно выделять диапазон...
( Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select )
0
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
24.03.2011, 09:41  [ТС] #5
Может быть все таки кто знает как передавать значения автофильтру через массив?

Вот как сие записывает автозапись макросов:

Visual Basic
1
2
3
4
5
6
7
8
9
Sub AutoFil()
' запись макроса автофильтра с выбором множественных значений (больше 2)
    Sheets(1).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$AF$77").AutoFilter Field:=2, Criteria1:=Array( _
        "запись 1", "запись 13", "запись 3", "запись 6"), Operator:= _
        xlFilterValues
End Sub
на основе этого я создатю массив и хочу передать его автофильтру

Visual Basic
1
2
3
4
5
6
7
    Dim ValueArr() ' массив значений
'    ...
'   тут заполнение массива ValueArr
'   ...
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$AF$77").AutoFilter Field:=2, Criteria1:=ValueArr, Operator:= _
        xlFilterValues
в таком виде ругается. Как подсунуть фильтру массив?
0
mc-black
2759 / 695 / 101
Регистрация: 04.02.2011
Сообщений: 1,421
24.03.2011, 11:52 #6
В твоем вчерашнем примере при заполнении массива была допущена ошибка, забыл про ReDim в цикле, возможно дело в этом? Протестируй мой вариант исправления бага:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub AutoFil()
    Dim i As Integer, s As Integer
    Dim ValueArr()
    s = 0
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            ReDim Preserve ValueArr(0 To s)
            ValueArr(s) = Me.ListBox1.List(i)
            s = s + 1
        End If
    Next i
 
'    ...
 
    Selection.AutoFilter
    ActiveSheet.Range(AF_Range).AutoFilter _
        Field:=Me.ComboBox2.ListIndex, _
        Criteria1:=ValueArr, _
        Operator:= xlFilterValues
 
End Sub
0
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
24.03.2011, 14:23  [ТС] #7
да, из-за ReDim'a я в панике уже целую тему создал. Так что там все объяснили и массив наконец создается.

но вот как его потом в автофильтре использовать... пока перебираю все варианты, которые приходят в голову (ValueArr, ValueArr(), Array(ValueArr)... и т.п.). Не помогает

Добавлено через 1 час 6 минут
Вобщем проблема пока обрисовалась такая: проверил после заполнения массив - ВСЕ кроме последнего пустые Может потому и ругается автофильтр, что с EMPTY работать не хочет?

заполнение ТОЧНО идет не пучтыми значениями. При ReDim могут затираться уже введеные?
0
mc-black
2759 / 695 / 101
Регистрация: 04.02.2011
Сообщений: 1,421
24.03.2011, 14:29 #8
Много вопросов. Отвечу на последний:
ReDim не будет затирать ранее добавленные данные, если его применять с модификатором Preserve:
Visual Basic
1
ReDim Preserve a(1 to 10) As String
0
leech
1 / 1 / 0
Регистрация: 17.11.2010
Сообщений: 24
25.03.2011, 17:38  [ТС] #9
ну вобщем вид автофильтра

Visual Basic
1
2
3
4
5
6
7
Dim ValueArr() As Variant
 
ValueArr = Array("Val1", "Val2", "Val3") 
Selection.AutoFilter
ActiveSheet.Range(AF_Range).AutoFilter _
    Field:=Me.ComboBox2.ListIndex, Criteria1:=ValueArr, _
    Operator:= xlFilterValues
будет радовать счастливых обладателей Office 2010... с остальными оно видимо не работает

Потому вопрос меняю. Про реализацию через автофильтр забудем. Можно ли передавать массив в sql-запрос (как переменную)?

Т.е. я создаю запрос через Microsoft Query. Снова включаю запись макроса, снова получаю макрос и снова вижу, что там явно указываются мои значения (те самые, которые я в предедущем варианте в массив запихал).

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub zapros()
'
' zapros
'
    Range("A1:A3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Names.Add Name:="MyTabl", RefersToR1C1:="=СВОД!R1C1:R77C32" 
    Workbooks.Add
    Windows("СВОД.xls").Activate
    Windows("Книга1").Activate
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DSN=Excel Files;DBQ=D:\MyPath\СВОД.xls;DefaultDir=D:\MyPath;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT MyTabl.`№п.п`, MyTabl.`Организация`, MyTabl.Сумма" & Chr(13) & "" & Chr(10) & "FROM `D:\MyPath\СВОД.xls`.MyTabl MyTabl" & Chr(13) & "" & Chr(10) & "WHERE (MyTabl.`Организация`='Орг 1') OR (MyTabl.`Организация`='Орг 1')" & Chr(13) & "" & Chr(10) & "ORDER BY MyTabl.`Организация`")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Query_запрос_из_Excel_Files"
        .Refresh BackgroundQuery:=False
    End With
End Sub
вот это мне надо повторить, но вместо явного указания полей и значений в SELECT'e использовать переменные и созданный ранее массив. Это реально сделать?
0
25.03.2011, 17:38
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.03.2011, 17:38

Макрос для Excel 2010, своего рода фильтр
Народ, помогите создать макрос для Excel 2010. Есть таблица в ней 5 столбцов...

VBA в Excel
Не могли бы вы помочь создать макрос в Excel, который бы выделял цветом в...

VBA Excel
Подскажите пожалуйста, как для трех выделенных ячеек со значениями длин...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru