Поиск столбца, фильтр и копирование - Мир MS Excel

Регистрация

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

= Мир MS Excel/Поиск столбца, фильтр и копирование - Мир MS Excel

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

Поиск столбца, фильтр и копирование (Макросы Sub)

Поиск столбца, фильтр и копирование

Дата: Четверг, 30.01.2014, 10:26 | Сообщение № 1

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

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

Сообщений: 152

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

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

Excel 2013, 2016

День добрый,

Подскажите, пожалуйста, как с помощью макроса сделать следующее..

дано:
- данные, которые копируются в файл извне (столбцов ~200, строк ~10 000),
- причем некоторые столбцы (выделено желтым) каждый раз меняют свое местоположение (напр DDD и BBB могут поменяться местами),

необходимо макросом:
1) найти столбец DDD и отфильтровать, оставив только значения >= 15
2) найти столбец BBB и отфильтровать, оставив только значения >= 15 (см ps.)
3) найти столбец EEE и отфильтровать, оставив только значения >= 15 (см ps.)
..) найти столбец .. и отфильтровать, оставив только значения ... – таких фильтров может быть много, потом добавлю уже сам по аналоги с предложенным кодом
4) скопировать отфильтрованную таблицу на новый лист (см. Sheet2)

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

К сообщению приложен файл: find_sort_copy.xlsm (11.8 Kb)

Сообщение отредактировал user0 - Четверг, 30.01.2014, 15:50

Ответить

Дата: Четверг, 30.01.2014, 10:53 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Привет
наверное, не отсортировать, а отфильтровать? Попробуйте
[vba]

Код

Sub ertert()
Dim arr, i&: arr = Array("DDD", "BBB", "EEE")
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To UBound(arr)
         .AutoFilter Field:=.Rows(1).Find(arr(i), lookat:=xlWhole).Column, Criteria1:=">=15"
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Дата: Четверг, 30.01.2014, 14:53 | Сообщение № 3

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

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

Сообщений: 152

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

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

Excel 2013, 2016

nilem,
спасибо, что откликнулись, да, конечно, отфильтровать )

еще один момент, на котором я не заострил внимание – критерии фильтра не обязательно одинаковые, они могут быть разными.
ваш код работает, но критерий один на всех, как бы его поменять, чтобы для каждого столбца можно было указать свое число..

ps. поправил в шапке описание

Сообщение отредактировал user0 - Четверг, 30.01.2014, 14:54

Ответить

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

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

например, так:
[vba]

Код

Sub ertert()
Dim arr, i&: arr = Array("DDD", ">=15", "BBB", ">20", "EEE", "<14")
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To UBound(arr) Step 2
         .AutoFilter Field:=.Rows(1).Find(arr(i), lookat:=xlWhole).Column, Criteria1:=arr(i + 1)
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Дата: Четверг, 30.01.2014, 16:10 | Сообщение № 5

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

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

Сообщений: 152

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

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

Excel 2013, 2016

спасибо огромное, то что надо и новые условия модифицировать/добавлять/удалять удобно.. красота
кстати, отдельное спасибо за Application.ScreenUpdating

ps. поблагодарил на я.д )

Сообщение отредактировал user0 - Четверг, 30.01.2014, 16:20

Ответить

Дата: Среда, 05.02.2014, 08:28 | Сообщение № 6

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

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

Сообщений: 152

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

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

Excel 2013, 2016

понадобилось добавить еще один вид фильтрации перед копированием данных на другой лист.

подскажите, пожалуйста, как изменить код, чтобы:
3.1) найти столбец ССС и отфильтровать, отобразив только наименьшие n значений (пусть будет 3), пустые ячейки не учитывать.

Сообщение отредактировал user0 - Среда, 05.02.2014, 09:42

Ответить

Дата: Среда, 05.02.2014, 11:39 | Сообщение № 7

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

по идее вот так:
[vba]

Код

Sub ertert()
Dim arr, i&: arr = Array("DDD", ">=15", xlAnd, _
                           "BBB", ">20", xlAnd, _
                           "EEE", "<14", xlAnd, _
                           "CCC", "3", xlBottom10Items)
Application.ScreenUpdating = False
With Sheets("Sheet1").Range("A1").CurrentRegion
      .Parent.AutoFilterMode = False
      For i = 0 To UBound(arr) Step 3
          .AutoFilter Field:=.Rows(1).Find(arr(i), lookat:=xlWhole).Column, _
                      Criteria1:=arr(i + 1), Operator:=arr(i + 2)
      Next i
          .Copy Sheets("Sheet2").Range("A1")
          .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

[/vba]
, но 3 наименьших значения будут отображаться не из уже отфильтрованных значений, а из всего столбца ССС.

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Среда, 05.02.2014, 15:46

Ответить

Дата: Среда, 05.02.2014, 15:23 | Сообщение № 8

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

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

Сообщений: 152

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

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

Excel 2013, 2016

Цитата nilem, 05.02.2014 в 11:39, в сообщении № 7

не из уже отфильтрованных значений, а по из всего столбца

хм, хотелось бы как раз из уже отфильтрованых..

чтобы не усложнять, может сделать этот фильтр(ы)* уже после копирования на Sheet2, а результат скопировать на Sheet3.
или сделать вообще отдельным макросом, который в свою очередь скопировать на третий лист (если бы онм запускался автомато после первого было бы вообще чудесно).

* на рабочих данных их будет несоколько, но для примера и одного хватит, как второй добавить по аналогии попробую додуматься сам )

Сообщение отредактировал user0 - Среда, 05.02.2014, 15:33

Ответить

Дата: Среда, 05.02.2014, 15:45 | Сообщение № 9

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Вообще, лучше сделать в массиве. Но там будут всякие x(i,3), y(j,4) и пр. - если хотите вручную менять критерии, то, наверное, сложновато получится. Поэтому "...может сделать этот фильтр(ы)* уже после копирования на Sheet2, а результат скопировать на Sheet3" так и сделаем:
[vba]

Код

Sub ertert()
Dim arr, i&: arr = Array("DDD", ">=15", xlAnd, _
                          "BBB", ">20", xlAnd, _
                          "EEE", "<0", xlAnd, _
                          "CCC", "3", xlBottom10Items)
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To 6 Step 3
         .AutoFilter Field:=.Rows(1).Find(arr(i), lookat:=xlWhole).Column, _
                     Criteria1:=arr(i + 1), Operator:=arr(i + 2)
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
     If .Rows.Count < 2 Then Exit Sub
     .AutoFilter Field:=.Rows(1).Find(arr(9), lookat:=xlWhole).Column, _
                 Criteria1:=arr(10), Operator:=arr(11)
     .Copy Sheets("Sheet3").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Среда, 05.02.2014, 15:50

Ответить

Дата: Среда, 05.02.2014, 17:33 | Сообщение № 10

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

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

Сообщений: 152

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

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

Excel 2013, 2016

тестирую на рабочих данных и что-то он как-то странно фильтрует второй лист )
почему-то копирутся на Sheet3 только 3 строки, а не строки где встречаются 3 самых маленьких числа..
давайте я вам покажу данные, так проще наверное будет (ссылку кинул в личку)

Ответить

Дата: Среда, 05.02.2014, 19:31 | Сообщение № 11

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Ну да, вот с такими параметрами "3", xlBottom10Items мы отфильтровываем 3 наименьших значения, т.е. как бы сортируем от меньшего к большему и выбираем первые 3 строки данных. Видимо, это не совсем то (или совсем не то), что нужно.
Тогда давайте еще больше накрутим

[vba]

Код

Sub ertert()
Dim arr, i&, x
arr = Array("EPS Rating", ">=85", _
               "RS Rating", ">=85", _
               "Comp Rating", ">=85", _
               "P/E", "10")
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
       .Parent.AutoFilterMode = False
       For i = 0 To 4 Step 2
           .AutoFilter .Rows(1).Find(arr(i), lookat:=xlWhole).Column, arr(i + 1)
       Next i
       .Copy Sheets("Sheet2").Range("A1")
       .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
       If .Rows.Count < 2 Then Exit Sub
       i = .Rows(1).Find(arr(6), lookat:=xlWhole).Column
       x = .Columns(i).Value
       Call Example_01(x)
       ReDim Preserve x(arr(7) - 1)
       x = Split(Join(x, "~"), "~")
       .AutoFilter i, x, 7
       .Copy Sheets("Sheet3").Range("A1")
           .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
       For j = 2 To UBound(x)
           If Not .Contains(x(j, 1)) Then .Add x(j, 1)
       Next j
       .Sort
       x = .ToArray
End With
End Sub

[/vba]
код скопируйте в стандартный модуль (Module1, например), а не в модуль листа. Разницы особой нет в данном случае, но все же...
в вашем файле в Sheet3 получилось 48 строк с заголовком.

Ну да, вот с такими параметрами "3", xlBottom10Items мы отфильтровываем 3 наименьших значения, т.е. как бы сортируем от меньшего к большему и выбираем первые 3 строки данных. Видимо, это не совсем то (или совсем не то), что нужно.
Тогда давайте еще больше накрутим

[vba]

Код

Sub ertert()
Dim arr, i&, x
arr = Array("EPS Rating", ">=85", _
               "RS Rating", ">=85", _
               "Comp Rating", ">=85", _
               "P/E", "10")
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
       .Parent.AutoFilterMode = False
       For i = 0 To 4 Step 2
           .AutoFilter .Rows(1).Find(arr(i), lookat:=xlWhole).Column, arr(i + 1)
       Next i
       .Copy Sheets("Sheet2").Range("A1")
       .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
       If .Rows.Count < 2 Then Exit Sub
       i = .Rows(1).Find(arr(6), lookat:=xlWhole).Column
       x = .Columns(i).Value
       Call Example_01(x)
       ReDim Preserve x(arr(7) - 1)
       x = Split(Join(x, "~"), "~")
       .AutoFilter i, x, 7
       .Copy Sheets("Sheet3").Range("A1")
           .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
       For j = 2 To UBound(x)
           If Not .Contains(x(j, 1)) Then .Add x(j, 1)
       Next j
       .Sort
       x = .ToArray
End With
End Sub

[/vba]
код скопируйте в стандартный модуль (Module1, например), а не в модуль листа. Разницы особой нет в данном случае, но все же...
в вашем файле в Sheet3 получилось 48 строк с заголовком.nilem

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Среда, 05.02.2014, 19:38

Ответить

СообщениеНу да, вот с такими параметрами "3", xlBottom10Items мы отфильтровываем 3 наименьших значения, т.е. как бы сортируем от меньшего к большему и выбираем первые 3 строки данных. Видимо, это не совсем то (или совсем не то), что нужно.
Тогда давайте еще больше накрутим

[vba]

Код

Sub ertert()
Dim arr, i&, x
arr = Array("EPS Rating", ">=85", _
               "RS Rating", ">=85", _
               "Comp Rating", ">=85", _
               "P/E", "10")
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
       .Parent.AutoFilterMode = False
       For i = 0 To 4 Step 2
           .AutoFilter .Rows(1).Find(arr(i), lookat:=xlWhole).Column, arr(i + 1)
       Next i
       .Copy Sheets("Sheet2").Range("A1")
       .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
       If .Rows.Count < 2 Then Exit Sub
       i = .Rows(1).Find(arr(6), lookat:=xlWhole).Column
       x = .Columns(i).Value
       Call Example_01(x)
       ReDim Preserve x(arr(7) - 1)
       x = Split(Join(x, "~"), "~")
       .AutoFilter i, x, 7
       .Copy Sheets("Sheet3").Range("A1")
           .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
       For j = 2 To UBound(x)
           If Not .Contains(x(j, 1)) Then .Add x(j, 1)
       Next j
       .Sort
       x = .ToArray
End With
End Sub

[/vba]
код скопируйте в стандартный модуль (Module1, например), а не в модуль листа. Разницы особой нет в данном случае, но все же...
в вашем файле в Sheet3 получилось 48 строк с заголовком.

Автор - nilem
Дата добавления - 05.02.2014 в 19:31

Дата: Четверг, 06.02.2014, 07:46 | Сообщение № 12

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

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

Сообщений: 152

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

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

Excel 2013, 2016

ок, сохраню код в модуль
да, теперь работает как задумывалось, спасибо большое

пытаюсь добавить новое условие для столбца "Est P/E" по аналогии с "P/E"..
добавить только "Est P/E", "5", _ в Array было бы слишком просто )
уже попробовал и продублировать код для sheet2 с example_01, применив его к sheet3 с последующим копированием на sheet4, но без особых успехов..

подскажите, пожалуйста, что и где необходимо поменять

Ответить

Дата: Четверг, 06.02.2014, 08:06 | Сообщение № 13

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

Ранг: Старожил

Сообщений: 1762

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

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

2003 & 2010

Цитата user0, 06.02.2014 в 07:46, в сообщении № 12

добавить только "Est P/E", "5", _ в Array было бы слишком просто

Ну, надо просто понять, что данные и размерность arr() участвуют как единое целое в последующих расчетах. Вы добавляете два элемента не в динамический массив (по идее), а в множество/массив констант (по сути). А nilem ориентировался на исходную задачу, и, естественно, ни на какие Ubound(arr) не стал закладываться...

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Ответить

Дата: Четверг, 06.02.2014, 08:53 | Сообщение № 14

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

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

Сообщений: 152

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

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

Excel 2013, 2016

а я чуть выше писал, что таких условий будет несколько.. Просто думал, что смогу сам модифицировать код и добавить хотя бы одно условие по аналогии, но это оказалось излишне самонадеянным

Ответить

Дата: Четверг, 06.02.2014, 19:32 | Сообщение № 15

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Ну вот, например, так:
[vba]

Код

Sub ertert()
Dim arrSh1, arrSh2, i&, j&, x
'an array of criteria for Sheet1
arrSh1 = Array("EPS Rating", ">=85", "RS Rating", ">=85", "Comp Rating", ">=85")
'an array of criteria for Sheet2
arrSh2 = Array("P/E", 10, "Est P/E", 4)
'arrSh2 = Array("P/E", 10) 'for example

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To UBound(arrSh1) Step 2
         .AutoFilter .Rows(1).Find(arrSh1(i), lookat:=xlWhole).Column, arrSh1(i + 1)
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
     If .Rows.Count < 2 Then Exit Sub
     For i = 0 To UBound(arrSh2) Step 2
         j = .Rows(1).Find(arrSh2(i), lookat:=xlWhole).Column
         .Columns(j).Copy Sheets("Sheet3").Range("AA1")
         x = Sheets("Sheet3").Range("AA1", Sheets("Sheet3").Cells(Rows.Count, "AA").End(xlUp)).Value
         Call Example_01(x)
         ReDim Preserve x(arrSh2(i + 1) - 1)
         x = Split(Join(x, "~"), "~")
         .AutoFilter j, x, 7
         Sheets("Sheet3").Range("AA:AA").ClearContents
     Next i
     .Copy Sheets("Sheet3").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
     For j = 2 To UBound(x)
         If Len(x(j, 1)) Then If Not .Contains(x(j, 1)) Then .Add x(j, 1)
     Next j
     .Sort
     x = .ToArray
End With
End Sub

[/vba]
вот это arrSh2 = Array("P/E", 10, "Est P/E", 4) означает, что сначала фильтруем по ст. "P/E" 10 наименьших, а потом из них фильтруем по ст. "Est P/E" 4 наименьших.

Ну вот, например, так:
[vba]

Код

Sub ertert()
Dim arrSh1, arrSh2, i&, j&, x
'an array of criteria for Sheet1
arrSh1 = Array("EPS Rating", ">=85", "RS Rating", ">=85", "Comp Rating", ">=85")
'an array of criteria for Sheet2
arrSh2 = Array("P/E", 10, "Est P/E", 4)
'arrSh2 = Array("P/E", 10) 'for example

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To UBound(arrSh1) Step 2
         .AutoFilter .Rows(1).Find(arrSh1(i), lookat:=xlWhole).Column, arrSh1(i + 1)
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
     If .Rows.Count < 2 Then Exit Sub
     For i = 0 To UBound(arrSh2) Step 2
         j = .Rows(1).Find(arrSh2(i), lookat:=xlWhole).Column
         .Columns(j).Copy Sheets("Sheet3").Range("AA1")
         x = Sheets("Sheet3").Range("AA1", Sheets("Sheet3").Cells(Rows.Count, "AA").End(xlUp)).Value
         Call Example_01(x)
         ReDim Preserve x(arrSh2(i + 1) - 1)
         x = Split(Join(x, "~"), "~")
         .AutoFilter j, x, 7
         Sheets("Sheet3").Range("AA:AA").ClearContents
     Next i
     .Copy Sheets("Sheet3").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
     For j = 2 To UBound(x)
         If Len(x(j, 1)) Then If Not .Contains(x(j, 1)) Then .Add x(j, 1)
     Next j
     .Sort
     x = .ToArray
End With
End Sub

[/vba]
вот это arrSh2 = Array("P/E", 10, "Est P/E", 4) означает, что сначала фильтруем по ст. "P/E" 10 наименьших, а потом из них фильтруем по ст. "Est P/E" 4 наименьших.nilem

Яндекс.Деньги 4100159601573

Ответить

СообщениеНу вот, например, так:
[vba]

Код

Sub ertert()
Dim arrSh1, arrSh2, i&, j&, x
'an array of criteria for Sheet1
arrSh1 = Array("EPS Rating", ">=85", "RS Rating", ">=85", "Comp Rating", ">=85")
'an array of criteria for Sheet2
arrSh2 = Array("P/E", 10, "Est P/E", 4)
'arrSh2 = Array("P/E", 10) 'for example

Application.ScreenUpdating = False
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
Sheets("Sheet3").Range("A1").CurrentRegion.ClearContents
With Sheets("Sheet1").Range("A1").CurrentRegion
     .Parent.AutoFilterMode = False
     For i = 0 To UBound(arrSh1) Step 2
         .AutoFilter .Rows(1).Find(arrSh1(i), lookat:=xlWhole).Column, arrSh1(i + 1)
     Next i
     .Copy Sheets("Sheet2").Range("A1")
     .AutoFilter
End With

With Sheets("Sheet2").Range("A1").CurrentRegion
     If .Rows.Count < 2 Then Exit Sub
     For i = 0 To UBound(arrSh2) Step 2
         j = .Rows(1).Find(arrSh2(i), lookat:=xlWhole).Column
         .Columns(j).Copy Sheets("Sheet3").Range("AA1")
         x = Sheets("Sheet3").Range("AA1", Sheets("Sheet3").Cells(Rows.Count, "AA").End(xlUp)).Value
         Call Example_01(x)
         ReDim Preserve x(arrSh2(i + 1) - 1)
         x = Split(Join(x, "~"), "~")
         .AutoFilter j, x, 7
         Sheets("Sheet3").Range("AA:AA").ClearContents
     Next i
     .Copy Sheets("Sheet3").Range("A1")
     .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Sub Example_01(x)
Dim j&
With CreateObject("System.Collections.ArrayList")
     For j = 2 To UBound(x)
         If Len(x(j, 1)) Then If Not .Contains(x(j, 1)) Then .Add x(j, 1)
     Next j
     .Sort
     x = .ToArray
End With
End Sub

[/vba]
вот это arrSh2 = Array("P/E", 10, "Est P/E", 4) означает, что сначала фильтруем по ст. "P/E" 10 наименьших, а потом из них фильтруем по ст. "Est P/E" 4 наименьших.

Автор - nilem
Дата добавления - 06.02.2014 в 19:32

Дата: Пятница, 07.02.2014, 03:37 | Сообщение № 16

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

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

Сообщений: 152

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

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

Excel 2013, 2016

Цитата nilem, 06.02.2014 в 19:32, в сообщении № 15

Ну вот, например, так

Спасибо, то что нужно !

ps. поблагодарил на я.д )

Ответить

Поиск столбца, фильтр и копирование (Макросы Sub)

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

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