Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Цепочка из связанных циклов
 
#1
28.07.2011 12:38:08
Добрый день, всем!  
 
Макрос, которого желательно автоматизировать является связь между блоками "BDа.xls"-база данных и "MatrixMnP.xls"-блок анализа.  
Вручную, рекордером сделал(часть кода прилагаю), но макрос получился жестко привязанный к конкретной странице.  
Хотелос бы его автоматизировать и сделать более универсальным, чтоб можно было его приложить и при добавлении на этой странице новые данные, и на других страницах, которые в примере не показал.  
   
Вот примерная логика макроса:  
1. По значении ячейки с адрессом: А1(Sheets("BD MN")), определяющее начало Первого диапазона, найти совпадение в колонки F:F.  
 
2. По значении ячейки с адрессом: А2(Sheets("BD MN")), определяющее конец Первого диапазона, найти совпадение в колонки F:F.  
 
3. По условию Down[т.е. если начальная строка содержить Down для выборки берем только строки, которые содержать UP, и наоборот:
если начальная строка содержить UP для выборки берем только строки, которые содержать Down](с адрессом: В1(Sheets("BD MN"))), взяв за начало 2-й строки Sheets("BD MN") выбрать все значения отвечающим    
условии UP, до конца Первого диапазона с колонки I:I и расположить их  в книге "MatrixMnP.xls", начиная с ячейки "F20" и дальше вниз.  
   Эти значения всегда расположены через одну строчку.  
 
4. Диапазоны не одинаковые по количество членов!  
 
5. Сценарии анализа зависит от условия начало(начальная строка) диапазона - Down (применяем Application.Run "MatrixMnP.xls!RANFJFJ02MnF"  
                                                                                            Application.Run "MatrixMnP.xls!Statistika9listovMnF)  
                                                                      или - UP   (применяем Application.Run "MatrixMnP.xls!RANFJFJ02MnFа"  
                                                                                            Application.Run "MatrixMnP.xls!Statistika9listovMnFа".  
 
6. Обработка страницы, в случае Sheets("BD MN"), заканчивается когда достигаем в колонки F:F до 0 или 1,    
(скорее до последней заполненной строке).  
   
Одно из решении вероятно будет - циклами.  
Один цикл = один диапазон.  
 
1.Начало первого цикла = А1(Sheets("BD MN"))  
  Конец первого цикла  = А2(Sheets("BD MN"))  
 
  Начало второго цикла = А2(Sheets("BD MN"))  
  Конец второго цикла  = А3(Sheets("BD MN"))...  
  Получается цепочка из связанных циклов.  
   
2.Циклы работают в колонке F:F.  
  Циклы обрабатывают разное количество ячеек, иногда только 2(начальная и конечная).  
 
  Сам вопрос: как сделать эту "цепочку из связанных циклов"?
 
 
 
#2
28.07.2011 12:53:53
объясните, что требуется "сделать" с данными книг
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#3
28.07.2011 13:04:19
{quote}{login=nerv}{date=28.07.2011 12:53}{thema=}{post}объясните, что требуется "сделать" с данными книг{/post}{/quote}  
 
Стоимость ячейки I2 с листа "BD MN" книги "BDа" перенести в ячейки "F20", книги "MatrixMnP.xls"  
 Стоимость ячейки I3 с листа "BD MN" книги "BDа" перенести в ячейки "F22", книги "MatrixMnP.xls"  
 Стоимость ячейки I5 с листа "BD MN" книги "BDа" перенести в ячейки "F24", книги "MatrixMnP.xls"  
 Стоимость ячейки I7 с листа "BD MN" книги "BDа" перенести в ячейки "F24", книги "MatrixMnP.xls"  
 Стоимость ячейки I9 с листа "BD MN" книги "BDа" перенести в ячейки "F28", книги "MatrixMnP.xls"  
  Дальше запуск макросов блока анализа, т.к. это пример и книга MatrixMnP неполная, то и запуск макросов невозможен!  
   На этом работа с первого  диапазона закончена, приступаем ко второго диапазона.  
   Начало второго диапазона является конец первого.
 
 
 
#4
28.07.2011 14:29:03
[F20]= ExecuteExcel4Macro("'c:\files\[BDа.xls]BD MN'!R2C9")
 
c:\files\ - замените на путь к вашей книге
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#5
28.07.2011 15:01:38
{quote}{login=nerv}{date=28.07.2011 02:29}{thema=}{post}[F20]= ExecuteExcel4Macro("'c:\files\[BDа.xls]BD MN'!R2C9")
 
c:\files\ - замените на путь к вашей книге{/post}{/quote}  
 
Заменил, в результате выскакивает окошко с предложением выбрать файл, после выбора файла стоимость ячейки I2 с листа "BD MN" книги "BDа" вставляется в ячейки "F20", книги "MatrixMnP.xls"  
 
Этот момент в моем макросе: SvyazBDasMatrix(он есть в примере) решил так:    
   Range("I2").Select     ' выбераем соответствующей стоимости  
   Selection.Copy          ' копируем ее  
   Windows("MatrixMnP.xls").Activate ' ставим ее в  
   Range("F20").Select                   ' ячейки  
   ActiveSheet.Paste                     ' F20 в книге "MatrixMn.xls"  
   Application.CutCopyMode = False  
   что, конечно не очень хорошее решение,  можно оптимизировать, но суть что оба варианта предполагают вручную определить границы диапазона и вручную перейти к следующему, а основная задача в:  
   "автоматизировать и сделать более универсальным(макроса), чтоб можно было его приложить и при добавлении на этой странице новые данные, и на других страницах, которые в примере не показал."  
   Данные, каждую минуту обновляются и диапазоны сдвигаются, появляются новые.  
   По этой причине думал, что цепочка "динамических" связанных циклов(если такое возможно!) решить проблемму с автоматизацией.  
   Как всегда, скорее всего плохо объяснил!:)
 
 
 
#6
28.07.2011 21:46:14
"По этой причине думал, что цепочка "динамических" связанных циклов(если такое возможно!) решить проблемму с автоматизацией."  
Пальцем в небо. Попробуй угадай, что это за "цепочка связанных циклов вас интересует.  
 
Вот Вам цепочка вложенных циклов:  
 
L1:  
For  
While  
Do  
Loop  
Wend  
Next  
If GoTo L1  
 
 
"Как всегда, скорее всего плохо объяснил!"  
Бинго!)
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#7
28.07.2011 22:33:20
Тогда, вот еще раз:  
 
"Одно из решении вероятно будет - циклами.  
 Один цикл = один диапазон.  
 
1. Начало первого цикла = А1(Sheets("BD MN"))  
   Конец первого цикла = А2(Sheets("BD MN"))  
2. Начало второго цикла = А2(Sheets("BD MN"))  
   Конец второго цикла = А3(Sheets("BD MN"))...  
3...Дальше третий, четвертый и т.д. до последней заполненной строке в колонке F:F Sheets("BD MN").  
   Начало и конец циклов определяем в колонке А:А Sheets("BD MN"), а сами цыклы включая их начало и конец находятся в колонке F:F Sheets("BD MN").  
 "Цепочка" - от того, что циклый следуют непосредственно одним за другим.  
 "Связанных" от того, что конец преидущего=начало следующего.  
"Динамических" из-за того, что ячеек в циклах разные по количество и страница постоянно обновляется и цыклы увеличиваются и сдвигаются.  
 Надеюсь, что сейчас понятнее!:)
 
 
 
#8
28.07.2011 22:38:19
{quote}{login=profx11}{date=28.07.2011 03:01}{thema=Re: }{post}  
 
 
Этот момент в моем макросе: SvyazBDasMatrix(он есть в примере) решил так:    
   Range("I2").Select     ' выбераем соответствующей стоимости  
   Selection.Copy          ' копируем ее  
   Windows("MatrixMnP.xls").Activate ' ставим ее в  
   Range("F20").Select                   ' ячейки  
   ActiveSheet.Paste                     ' F20 в книге "MatrixMn.xls"  
   Application.CutCopyMode = False  
   что, конечно не очень хорошее решение{/post}{/quote}  
 
 
Sub tt()  
'один раз объявляем переменные  
   Dim bd As Object  
   Dim mnp As Object  
     
'один раз определяем переменные, хотя так коряво, нужно определять при открытии, и плюс конкретно определённый лист, а не что попало  
   Windows("BDa.xls").Activate  
   Set bd = ActiveSheet  
   Windows("MatrixMnP.xls").Activate  
   Set mnp = ActiveSheet  
     
'ну и собственно копирование  
   bd.[I2].Copy mnp.[F20]
 
End Sub
 
 
 
#9
28.07.2011 22:48:35
Спасибо Hugo за ответ!  
 
Коряво, потому что рекордером делал, еще не подчищал.  
Но не смотря на это макрос акуратно все делает, если запустите через F8, сами убедитесь, но требуется "автоматическое" разпознавание диапазонов-циклов, а этого как раз в моего макроса и нет!  
Сейчас попробую, что вы посоветовали и отпишусь.
 
 
 
#10
28.07.2011 23:00:06
Я всёж не вполне понял, что именно нужно сделать.  
А копировать проще так - определили ссылки на нужные листы, потом только  
 
bd.[I2].Copy mnp.[F20]
bd.[I4].Copy mnp.[F22]
bd.[I6].Copy mnp.[F24]
bd.[I8].Copy mnp.[F26]
 
или сразу  
 
bd.[I2:I8].Copy mnp.[F20]
 
если можно всё подряд копировать.
 
 
 
#11
28.07.2011 23:34:39
Ещё раз перечитал первый пост - вроде прояснилось. Но поздно - спать пора :(
 
 
 
#12
28.07.2011 23:52:54
"Я всёж не вполне понял, что именно нужно сделать."  
Попробую еще раз объяснить.  
Лист Sheets("BD MN"), книги "BDa.xls" - это первый лист базы данных, она постоянно обновляется.  
В столбца  "А:А" этого листа даны последовательно, начиная с А1 начало и конец всех диапазонов(циклов).  
А1 - начало первого;  
А2 - конец первого = начало второго;  
А3 - конец трьетего = начало четвертого;  
А4 - котец четвертого = начало пятого ... и так до последней заполненой строчки столбца.  
Средствами VBA требуется определить эти диапазоны(или циклы - если так удобнее).  
Далее, переносимся в столбце  "F:F" Sheets("BD MN"), здесь уже эти  диапазоны(циклы) находятся в развернутом виде.  
Например Первый диапазон, который начался в А1 и имеет обозначение 398 заканчивается в А2 с обозначением 369 имеет в  "F:F" следующий вид:  
F2 - 398=А1  
F3 - 393  
F4 - 392  
F5 - 384  
F6 - 381  
F7 - 377  
F8 - 375  
F9 -.369=А2  
Выборка всех этих 8 ячеек и надо сделать в книге "MatrixMnP.xls", начиная с ячейки F20 - F2 - 398=А1 Down  1.8052  
                         F22 - F3 - 393       UP      2.0980  
                         F24 - F5 - 384       UP      2.3290  
                         F24 - F7 - 377       UP      2.3216  
                         F24 - F9 -.369=А2  UP     2.4658  
 После выборки запускаем макросы для анализа.  
 Потом начинаем поиск и выборки второго диапазона(цикла) и так до конца - до последней заполненой строки А:А, или в развернутом виде "F:F.  
Спокойной ночи!:)
 
 
 
#13
28.07.2011 23:59:52
Перечитал все сообщения автора - мало что понял. Хотя, написано много...
 
 
 
#14
29.07.2011 09:32:22
"В столбца "А:А" этого листа даны последовательно, начиная с А1 начало и конец всех диапазонов(циклов).  
А1 - начало первого;  
А2 - конец первого = начало второго;  
А3 - конец трьетего = начало четвертого;  
А4 - котец четвертого = начало пятого ... и так до последней заполненой строчки столбца."  
 
не стоит путать "количество циклов" с "количеством проходов цикла/циклов"  
пример. Цикл 1, прохода 4-е  
 
sub io()  
DIm x  
For each x in Sheets("BD MN").Range("А1, А2, А3, А4")  
 
next  
end sub
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#15
29.07.2011 11:16:35
На всякии случай,  база данных с двумя листами.  
   
Спасибо nerv за подсказку, пока выдает ошибку:  
 
Run-time error '9':  
Subscript out of range
 
 
 
#16
29.07.2011 14:22:47
так вот и приложили бы код выдающий ошибку. гядишь и причина ошибки найдется
 
 
 
#17
29.07.2011 14:57:10
Такая заготовка:  
 
 
Sub tt()  
Dim cc As Range  
 
For Each cc In [a1:a17]
Select Case cc.Offset(, 1).Value  
Case "Down": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnF"""  
Case "Up": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnFa"""  
Case Else: str_ = ""  
End Select  
 
MsgBox cc.Value & " = start" & vbNewLine & cc.Offset(1).Value & " = end" & vbNewLine & str_  
Next  
End Sub  
 
 
Т.е. проходим циклом по исходному диапазону (можно задать динамически, до последней заполненной строки).  
Имеем оба значения для поиска и Down/Up.  
Сюда добавить перебор второго массива (можно именно взять диапазон в массив и перебирать его) - как нашли первое значение, извлекаем цифры, и потом перебираем дальше до второго, извлекая только цифры Down/Up.  
Если цифры берём из массива, то заносим в второй файл не копированием, а присвоением значений, типа  
mnp.[F22] = arr(i,4)
 
Это пока туманно, но вроде несложно алгоритм должно быть придумать.
 
 
 
#18
29.07.2011 15:21:37
to profx11: Вы это (см. ниже) прям так скопировали и хотели, чтобы все заработало?)  
 
sub io()  
DIm x  
For each x in Sheets("BD MN").Range("А1, А2, А3, А4")  
 
next  
end sub
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#19
29.07.2011 17:02:16
Такая теперь заготовка - в модуль любого файла, но Ваши файлы должны быть открыты.  
Вместо последней части кода с месиджами можно сразу запускать нужные другие коды.  
 
Sub ttt()  
Dim cc As Range, start_, end_, param$, arr, i&, flag As Boolean  
Dim trget As Range  
Dim bd As Object  
Dim mnp As Object  
 
Windows("BDa.xls").Activate  
Set bd = ActiveSheet  
Windows("MatrixMnP.xls").Activate  
Set mnp = ActiveSheet  
 
 
arr = bd.[f1:i100].Value
 
For Each cc In bd.[a1:a17]
mnp.Columns(6).ClearContents  
Set trget = mnp.[F20]
start_ = cc.Value  
end_ = cc.Offset(1).Value  
param = cc.Offset(, 1).Value  
flag = False  
 
For i = 1 To UBound(arr)  
If Not flag Then  
   If arr(i, 1) = start_ Then  
   flag = True  
   trget = arr(i, 4)  
   Set trget = trget.Offset(2)  
   End If  
Else  
       If arr(i, 1) <> end_ Then  
           If arr(i, 2) = param Then  
           trget = arr(i, 4)  
           Set trget = trget.Offset(2)  
           End If  
       Else  
       Exit For  
       End If  
End If  
Next  
 
Select Case param  
Case "Down": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnF"""  
Case "Up": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnFa"""  
Case Else: str_ = ""  
End Select  
 
MsgBox cc.Value & " = start" & vbNewLine & cc.Offset(1).Value & " = end" & vbNewLine & str_  
 
Next  
End Sub
 
 
 
#20
29.07.2011 18:28:19
HUGO, спасибо за терпение вникать в проблемму!:)  
 
Пока прокручиваю с клавишей F8 без фрагмента:  
"Select Case param  
 Case "Down": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnF"""  
 Case "Up": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnFa"""  
 Case Else: str_ = ""  
 End Select  
 
 MsgBox cc.Value & " = start" & vbNewLine & cc.Offset(1).Value & " = end" & vbNewLine & str_".  
 
 С ним выдает сообщение:  
   
 Compile error:  
 Variable not defined  
 
 высвечивается: str_  
----------------------------------------------------------------------------------------------  
 Прокрутил несколько раз, срабатывает акуратно!  
 
 В уточнение нуждается только условие: "Down"/"Up", еще раз уточню  
 Когда начало диапазона совпадает с "Down" - то выборку делаем только со строчек совпадающими с "Up" и наоборот, например:  
 1. Диапазон 398-369 выборку делаем(конечно в ячейке F20 всегда ставим значение начало диапазона, в случае 398-1.8052)    
со строчками "Up":  
    393, 384, 377 и 369;  
 2. Диапазон 369-317 выборку делаем(конечно в ячейке F20 всегда ставим значение начало диапазона, в случае 369-2.4658)  
со строчками "Down":  
    359, 340, 330 и 317;  
 3. Диапазон 317-279 выборку делаем(конечно в ячейке F20 всегда ставим значение начало диапазона, в случае 317-1.0405)    
со строчками "Up":  
    307, 303, 290, 283 и 279;  
  и т.д.  
 И 14-й диапазон:  
    Диапазон 30-3 выборку делаем(конечно в ячейке F20 всегда ставим значение начало диапазона, в случае 30-1.3503)    
со строчками "Up":  
    23, 20, 8 и 3.
 
 
 
#21
29.07.2011 22:48:31
Это хорошо, что запустили. Значит сами и наладить позже сумеете.  
1. Про переменную забыл - просто объявите в начале кода  
Dim str_$  
или можно в любую строку объявления после запятой дописать.  
2. С сменой Down/Up есть несколько вариантов -    
а)изменить определение param  
param = cc.Offset(1, 1).Value  
т.е. брать значение правее и ниже, а не просто правее  
б)изменить анализ значения на противоположный:  
If arr(i, 2) <> param Then  
 
Для теста так код поменял - тут выводит в месиджбокс значение param, а на лист после цифр пишет тоже это значение из этой строки.  
Не понял, что нужно выводить из первой строки - там ведь эти значения совпадают?  
 
Option Explicit  
 
Sub ttt()  
   Dim cc As Range, start_, end_, param$, arr, i&, flag As Boolean  
   Dim trget As Range, str_$  
   Dim bd As Object  
   Dim mnp As Object  
 
   Windows("BDa.xls").Activate  
   Set bd = ActiveSheet  
   Windows("MatrixMnP.xls").Activate  
   Set mnp = ActiveSheet  
 
 
   arr = bd.[f1:i100].Value
 
   For Each cc In bd.[a1:a17]
       mnp.Columns(6).ClearContents  
       Set trget = mnp.[F20]
       start_ = cc.Value  
       end_ = cc.Offset(1).Value  
       param = cc.Offset(, 1).Value  
       flag = False  
 
       For i = 1 To UBound(arr)  
           If Not flag Then  
               If arr(i, 1) = start_ Then  
                   flag = True  
                   trget = arr(i, 4) & arr(i, 2)  
                   Set trget = trget.Offset(2)  
               End If  
           Else  
               If arr(i, 1) <> end_ Then  
                   If arr(i, 2) <> param Then  
                       trget = arr(i, 4) & arr(i, 2)  
                       Set trget = trget.Offset(2)  
                   End If  
               Else  
                   Exit For  
               End If  
           End If  
       Next  
 
       Select Case param  
       Case "Down": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnF"""  
       Case "Up": str_ = "Application.Run ""MatrixMnP.xls!RANFJFJ02MnFa"""  
       Case Else: str_ = ""  
       End Select  
 
       MsgBox cc.Value & " = start" & vbNewLine & cc.Offset(1).Value & " = end" & vbNewLine & str_ & vbNewLine & param  
 
   Next  
End Sub  
 
В общем, погоняйте с месиджем, а потом можете так пару строк заменить:  
 
 
       Case "Down": Application.Run "MatrixMnP.xls!RANFJFJ02MnF"  
       Case "Up": Application.Run "MatrixMnP.xls!RANFJFJ02MnFa"  
 
будут выполняться макросы в зависимости от параметра.
 
 
 
#22
29.07.2011 22:53:58
Да, толко на рабочем коде уберите дописывание значения параметра в  
trget = arr(i, 4) & arr(i, 2)  
т.е. оставьте в 2х местах  
trget = arr(i, 4)  
 
И запуск макросов из этого же модуля можно так записать:  
Case "Down": RANFJFJ02MnF  
Case "Up": RANFJFJ02MnFa  
 
Или какие там нужно запускать...  
Если нужно несколько, то так пишите:  
 
Select Case param  
Case "Down"  
макрос1  
макрос2  
Case "Up"  
макрос3  
макрос4  
End Select  
 
И переменная str_ тогда больше не нужна, месиджбокс ведб тоже уже не нужен.
 
 
 
#23
29.07.2011 23:01:11
Забыл сказать - ещё осталось добавить динамическое определение диапазонов. Ну это легко потом добавить.  
В принципе, можно и первый диапазон загрузить в массив и потом брать значения из него - но там метод offset не работает, тогда нужно индекс+1 использовать, и я подумал, что сложнее будет Вам понять два вложенных цикла по массивам. Да и на таком небольшом объёме выигрыша в скорости заметно не будет.
 
 
 
#24
29.07.2011 23:08:59
Спасибо!  
 
Завтра, на свежую голову попробую, погоняю вдоволь, даже в строчку  
 
For Each cc In bd.[a1:a17]
 
попробую a17 заменить на "динамически, до последней заполненной строки"  
 
Еще раз, спасибо и спокойной ночи!:)
 
 
 
Страницы: 1
Читают тему
Наверх