Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Перенос строк по заданным на листе условиям 2
 
#1
30.05.2012 12:34:08
Всем доброго дня!  
Решила создать свою тему, хотя она обсуждалась примерно неделю назад вот здесь:  
(http://www.planetaexcel.ru/forum.php?thread_id=41678)  
Я немножко усложнила задачку Евгения. Нужно сделать, чтобы копирование из листа "Date" происходило по двум критериям, заданным в листе "Condition". Возможно ли это?  
Крутила сама макрос, но так ни к чему не пришла.  
Заранее благодарю за помощь  
файл в формате xlsm так как по утверждению уважаемого Hugo, макрос работает только на 2007/10 экселе.
 
 
 
#2
30.05.2012 12:49:23
Попробуйте так:  
.[E:E].AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=Application.Transpose(Sheets("Condition").[A2].CurrentRegion.Columns(1).Value)
.[F:F].AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:=Application.Transpose(Sheets("Condition").[B2].CurrentRegion.Columns(2).Value)
[A2] или [B2] - роли не играет, т.к. это одна таблица и один CurrentRegion.
Я проверить не могу - на 2003 сижу сейчас.  
Вам нужно было получить как критерий массив из одного столбца.  
Другой вариант - писать критерии в "отдельностоящие" столбцы.
 
 
 
#3
30.05.2012 13:18:16
Hugo! Спасибо что откликнулись.  
При добавлении строки для второго столбца, копирование вообще не происходит.  
Даже с ...[B2].CurrentRegion.Columns(2)
"Отдельностоящие" столбцы (А и С), если я правильно поняла, так же не дали результата.  
Может есть еще варианты?    
Если нет, тогда будем ждать 2007-й...:-))
 
 
 
#4
30.05.2012 13:28:46
Хотя я не то предложил - так отфильтрует все города и все продукты, без привязки к парам.  
Т.е. и Москва-Редис тоже.  
Думаю фильтром не получится... Нужно циклом перебирать и скрывать ненужное, потом видимые копировать.
 
 
 
#5
30.05.2012 13:44:18
В моем файле пара сотен строк.))  Из всего этого надо выбрать около пары десятков совпадений. Файл приходит раз в месяц. Хотелось бы все это автоматизировать
 
 
 
#6
30.05.2012 14:01:41
{quote}{login=Julis}{date=30.05.2012 01:44}{thema=}{post}В моем файле пара сотен строк.))  Из всего этого надо выбрать около пары десятков совпадений. Файл приходит раз в месяц... {/post}{/quote}  
Надорваться можно!.. ;) А мо быть ну его макрос, давай AF (расширенный фильтр)?! Делов-то - раз в месяц... Как вариант... И если чё - рекордером его это самое - записать... -29682-
 
 
 
#7
30.05.2012 14:12:30
Если нужно выбрать только значения - тогда делайте перебором массива из диапазона выборку нужных значений в другой массив.  
Будет быстро.  
Примеров было много - мне сейчас некогда делать, обед на носу :)
 
 
 
#8
30.05.2012 15:33:12
Будет быстро на любом количестве строк.  
 
Option Explicit  
 
Sub Move_()  
   Dim a(), oDict As Object, tmp$, i&, ii&, x As Byte  
   Set oDict = CreateObject("Scripting.Dictionary")  
   oDict.CompareMode = 1  
 
   Application.ScreenUpdating = False  
 
   a = Sheets("Condition").[A1].CurrentRegion.Value
   For i = 1 To UBound(a)  
       tmp = Trim(a(i, 1)) & "|" & Trim(a(i, 2))  
       oDict.Item(tmp) = vbNullString  
   Next  
 
   a = Sheets("Data").[A1].CurrentRegion.Value
   ReDim b(1 To UBound(a), 1 To 6)  
   For i = 1 To UBound(a)  
       tmp = Trim(a(i, 5)) & "|" & Trim(a(i, 6))  
 
       If oDict.exists(tmp) Then  
           ii = ii + 1  
           For x = 1 To 6: b(ii, x) = a(i, x): Next  
       End If  
   Next  
 
   With Sheets("Moved")  
       .[A:F].Clear
       If ii > 0 Then .[A1].Resize(ii, 6) = b
   End With  
 
   Application.ScreenUpdating = True  
   Sheets("Moved").Select  
End Sub
 
 
 
#9
30.05.2012 15:41:57
Чуть лишнее повыкидывал:  
 
Sub Move_()  
   Dim a(), i&, ii&, x As Byte  
 
   With CreateObject("Scripting.Dictionary")  
       .CompareMode = 1  
 
       a = Sheets("Condition").[A1].CurrentRegion.Value
       For i = 1 To UBound(a)  
           .Item(Trim(a(i, 1)) & "|" & Trim(a(i, 2))) = vbNullString  
       Next  
 
       a = Sheets("Data").[A1].CurrentRegion.Value
       ReDim b(1 To UBound(a), 1 To 6)  
       For i = 1 To UBound(a)  
           If .exists(Trim(a(i, 5)) & "|" & Trim(a(i, 6))) Then  
               ii = ii + 1  
               For x = 1 To 6: b(ii, x) = a(i, x): Next  
           End If  
       Next  
 
   End With  
 
   With Sheets("Moved")  
       .[A:F].Clear
       If ii > 0 Then .[A1].Resize(ii, 6) = b
       .Select  
   End With  
 
End Sub  
 
 
Кстати, количество condition тоже может быть любое - особо на скорость не повлияет.
 
 
 
#10
30.05.2012 18:01:15
Спасибо, Hugo  
Сейчас у меня уже нет компьютера под рукой, поэтому только завтра смогу проверить ваш макрос и сообщить результат
 
 
 
#11
30.05.2012 18:30:03
Справедливости ради стоит отметить, что "перенос" и "moved" тут нигде не происходит. Только копирование. :)
 
 
 
#12
31.05.2012 10:44:58
Все прекрасно работает. И под 2003-й подходит.    
Еще раз спасибочки.  
 
PS. Вопрос совсем не по теме: последние дни Планета очень долго загружается. Именно Планета. Другие сайты загружаются быстро. У кого то есть подобная проблема?
 
 
 
#13
31.05.2012 11:04:57
У меня есть :(  
И Сергей упоминал - так что думаю у всех...
 
 
 
#14
31.05.2012 11:29:37
Еще вопросик:  
Чисто теоретически, если понадобиться сортировка по ТРЁМ критериям, нужно переделывать весь код или достаточно изменить какое то значение?
 
 
 
#15
31.05.2012 12:00:11
Достаточно изменить тут  
.Item(Trim(a(i, 1)) & "|" & Trim(a(i, 2))) = vbNullString  
и тут  
If .exists(Trim(a(i, 5)) & "|" & Trim(a(i, 6))) Then  
Дописать ещё например & Trim(a(i, 3)  
Т.е. сперва запоминаем в словаре строку из нужных данных (разделитель ставьте любой, какого нет в этих данных, для надёжности).  
Затем из анализируемых данных извлекаем аналогичную строку и смотрим, есть ли она в словаре (т.е. нужно ли эту строку отбирать).  
Можно сперва создать несколько разных словарей из разных комбинаций параметров, затем аналогично проверить по этим словарям, и по результату проверки копировать строки в разные массивы.  
Т.е. например разложить общий список на 3 по "кондишкам" за один проход по списку. Быстро.
 
 
 
#16
31.05.2012 12:18:40
Сложновато конечно, но идея ясна. Будем грызть гранит знаний...))
 
 
 
#17
31.05.2012 12:31:32
Ну не так уж сложно - глаза боятся, руки делают :)  
И уточню одну деталь - Trim() ставить не обязательно, это "защита от дурака".  
Если данные в таблице не вводятся "дураками", то очищать от возможных лишних пробелов по концам нет нужды.  
С другой стороны, если данные вводят совсем уж "дураки", то возможно нужен уже application.trim(), чтоб и внутри связки слов убирать возможные задвоения пробелов.
 
 
 
Страницы: 1
Читают тему
Loading...