Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Макрос выборки данных
 
#1
07.10.2010 10:51:43
Добрый день, нужен макрос для выборки данных и заполнению таблицы.    
Файл стаблицами и условиями прилагаю. Помогите с макросом.
 
 
 
#2
07.10.2010 11:15:22
По Вашему алгоритму:  
1. Ищем на исходной таблице значения с номером 76232 (строки с 29 по 58)  
2. Находим максимальное АБСОЛЮТНОЕ значение из колонки N в найденных строках (161,091) и соответствующие значения Му (-1,707) и Мz(-8,428)  
3. Суммируем значения =161,091+(-1,707)+(-8,428)=150,956  
4. Находим следующее максимальное абсолютное значение из колонки N в найденных строка (160,497), Му(-1,93), Mz(-8.437)  
5. Суммируем 160,497-1,93-8,437=150,13  
6. Сравниваем - наибольший результат дает 1 комбинация (150,956)  
7. Записываем в строку 3 таблицы на листе 1 значения -161,091  -1,707 -8,428  
Пока все правильно?  
"...дальше все тоже самое, но только по колонке Му" - не понял вообще. В туже строку таблицы результатов писать? Максимальное абсолютное значение складывать с N и Мz?  
 
Как надо-то?  
Наверное, было бы лучше, если б Вы в примере хотя б 2 строчки заполнили в результирующей таблице руками с пояснениями - это так получилось, это сяк и т.д.  
Пока я не могу понять алгоритм заполнения.  
 
 
ВАУ! 44288
 
 
 
#3
07.10.2010 12:40:51
Заполнила результирующую таблицу, разным цветом выделила выбранные значения по N и My
 
 
 
#4
07.10.2010 14:54:07
Уважаемые форумчане!  
 
Помогите, очень надо решить данную задачку, а знаний в макрасах чуть-чуть....
 
 
 
#5
07.10.2010 19:04:23
Макрос выборки данных по колонке N написала:  
 
Public Sub Заполнить максзначение по N()  
   Const rowStart = 8  
   Const colID = 1  
   Const colN = 4    
   Const colMy = 6    
   Const colMz = 7      
   Const rowResStart = 3    
   Const colResID = 7      
   Const colResN = 2    
   Const colResMy = 3    
   Const colResMz = 4    
   Const shtSource = "1. Усилия и напряжения комбин"  
   Const shtResult = "Лист1"  
     
   Dim lngRow As Long  
   Dim lngInd As Long  
   Dim strRead As String  
   Dim strFind As String  
   Dim varN As Variant  
   Dim varMy As Variant  
   Dim varMz As Variant  
   Dim varNewN As Variant  
   Dim varNewMy As Variant  
   Dim varNewMz As Variant  
     
     
   lngInd = rowResStart  
   strRead = Trim$(ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResID).Value)  
   Do While strRead <> ""  
         
       If IsNumeric(strRead) Then  
           varN = 0  
           varMy = 0  
           varMz = 0  
           lngRow = rowStart  
           strFind = Trim$(ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colID).Value)  
           Do While strFind <> ""  
                 
               If CLng(strFind) > CLng(strRead) Then Exit Do  
                 
               If CLng(strFind) = CLng(strRead) Then  
                   varNewN = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colN).Value  
                   varNewMy = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colMy).Value  
                   varNewMz = ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colMz).Value  
                     
                   If Abs(varNewN) >= Abs(varN) Then  
                       varN = varNewN  
                       varMy = varNewMy  
                       varMz = varNewMz  
                   End If  
                     
               End If  
                 
                 
               lngRow = lngRow + 1  
               strFind = Trim$(ActiveWorkbook.Sheets(shtSource).Cells(lngRow, colID).Value)  
           Loop  
             
             
           ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResN).Value = varN  
           ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResMy).Value = varMy  
           ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResMz).Value = varMz  
         
       End If  
         
       lngInd = lngInd + 1  
       strRead = Trim$(ActiveWorkbook.Sheets(shtResult).Cells(lngInd, colResID).Value)  
   Loop  
     
End Sub  
 
 
 
а как и что дальше незнаю......  
Помогите, пожлуйста!
 
 
 
#6
07.10.2010 22:47:38
Честно говоря, не разобрался... слишком как-то сложно.  
Я пошёл другим путём, пока не дошёл, но заготовку могу показать, может сами доделаете быстрее.  
Нужные значения уже нашёл, осталось их скопировать в таблицу.  
Доделать аналогичный поиск по второму столбцу номеров (пока не думал, как и куда лучше вставить) и динамически определить диапазоны ( и нединамически переменные :))  
 
Sub tt()  
   Dim a, b  
   a = [g3:g10] ' массив номеров
   b = Sheets(1).[a2:f178] ' массив значений
   For i = 1 To UBound(a) 'цикл по номерам  
       If a(i, 1) > 0 Then 'только значения объединённых ячеек  
       maxb = 0: maxb2 = 0: maxbind = 0: maxb2ind = 0 'обнуляем максимальные и номера нужных индексов значений массива  
           For ii = 1 To UBound(b) 'цикл по значениям  
               If b(ii, 1) = a(i, 1) Then 'если совпадает  
                   If Abs(b(ii, 4)) > maxb Then 'если максимальное  
                       maxb2 = maxb: maxb2ind = maxbind 'запоминаем предыдущее максимальное и его положение в массиве  
                       maxb = Abs(b(ii, 4)): maxbind = ii 'запоминаем  максимальное и его положение в массиве  
                   End If  
               End If  
           Next  
           'сравниваем суммы  
           If Abs(b(maxbind, 4)) + Abs(b(maxbind, 5)) + Abs(b(maxbind, 6)) >= Abs(b(maxb2ind, 4)) + Abs(b(maxb2ind, 5)) + Abs(b(maxb2ind, 6)) Then  
           MsgBox maxbind 'озвучиваем индекс нужного значения массива  
           Else  
           MsgBox maxb2ind  
           End If  
       End If  
   Next  
End Sub
 
 
 
#7
07.10.2010 22:54:22
эээ, не по по второму столбцу номеров, а определение максимальных по My...
 
 
 
#8
07.10.2010 23:18:03
стоп, ошибка в алгоритме определения немаксимального... после максимума меньшее не определяется.
 
 
 
#9
07.10.2010 23:25:58
решил второй максимум...
 
 
 
#10
08.10.2010 00:01:36
Проверяйте.  
Не понял, что там справа внизу за маленькие таблицы (Выборка по максимальному N).  
Но и их сформировать не трудно.
 
 
 
#11
08.10.2010 07:22:41
Большое спасибо! это почти то, что надо )  
вот если бы для позиции он делал бы проверку не по одному номеру(из колонки G) а по обоим номерам (G и H)  
и почему то когда я добавляю новые позиции (337, 338 итд) он отказыается считать дальше...  
 
А в остальном все супер!
 
 
 
#12
08.10.2010 09:25:56
{quote}{login=Natali}{date=08.10.2010 07:22}{thema=}{post}Большое спасибо! это почти то, что надо )  
вот если бы для позиции он делал бы проверку не по одному номеру(из колонки G) а по обоим номерам (G и H)  
и почему то когда я добавляю новые позиции (337, 338 итд) он отказыается считать дальше...  
 
А в остальном все супер!{/post}{/quote}  
 
Да, точно, забыл массив "c" сделать динамическим. Надо так изменить этот блок:  
 
   a = Range("g3:g" & Range("G" & Rows.Count).End(xlUp).Row)  ' массив номеров  
   b = Sheets(1).Range("a2:f" & Sheets(1).Range("F" & Rows.Count).End(xlUp).Row)    ' массив значений  
   ReDim c(1 To Range("G" & Rows.Count).End(xlUp).Row, 1 To 3) 'массив результатов  
 
Но тут рассчитано, что в столбце G будут объединённые попарно ячейки - иначе может места для всех значений не хватить. А так берётся двойное количество объединённых -1  + 2(шапка) - как раз хватает с хвостиком :)  
А вот про "а по обоим номерам (G и H)" не понял - где номера из Н на первом листе, и куда писать полученные данные, если их получим?  
Но имхо это можно сделать вторым аналогичным кодом вторым заходом, если вставить в этот будет затруднительно - меняем в этом коде привязку к диапазонам и всё.
 
 
 
#13
08.10.2010 11:04:46
УРРРАААА )))) работает!!!    
В том файле приведена только маленькая часть таблицы, в которую элементы из столбца H не попали...реальная таблица имеет порядка 20000 строк )    
 
Мы уже получили необходимый нам результат - 6 значений! которые относятся к позиции из первого столбца. Но эта позиция состоит из нескольких элементов. (К примеру Поз. 333 из элементов 76232 и 81984). Тоесть нам надо сделать ту же самую выборку, только в более широком диапазоне
 
 
 
#14
08.10.2010 11:14:49
Ну так если в моём коде разберётесь (я думаю можно разобраться) - его легко масштабировать и переделывать.  
А скорость на массивах позволяет и несколько разных копий кода в цепочку ставить - будет вместо 3-х секунд 6 работать...
 
 
 
#15
08.10.2010 11:35:30
разберусь! огромное спасибо! )
 
 
 
#16
09.10.2010 12:14:52
Hugo, уделите еще минуточку пожалуйста...  
Мне кажется, что решение второго максимума должно немного по другому выглядеть...  
 
If Abs(b(ii, 4)) > maxb2 Then      
   If Abs(b(ii, 4)) > maxb Then  
       maxb2 = maxb: maxb2ind = maxbind      
       maxb = Abs(b(ii, 4)): maxbind = ii      
   Else                              
       maxb2 = Abs(b(ii, 4)): maxbind = ii        
   End If  
End If  
 
Я правильно думаю?
 
 
 
#17
09.10.2010 18:05:37
Да, что-то там у меня неправильно... хотя результат от Вашего кода на примере не отличается.  
Но проверка условия в Вашем коде  
If Abs(b(ii, 4)) > maxb Then  
у Вас лишняя, т.к. это проверено уже выше по коду и там уже присвоено  
maxb = Abs(b(ii, 4))  
т.е. Abs(b(ii, 4)) > maxb уже никогда не будет.  
А только Ваш код без моей первой проверки результат дат совсем другой.  
Я ведь тоже такую задачу раньше не решал - так что решаю эту головоломку на равне с Вами, тут уже не знания ВБА нужны, а чисто логика...  
Подумаю попозже, что-то пока не складывается.
 
 
 
#18
09.10.2010 18:58:48
Вроде так правильно (на оба столбца, N и My), взгляните со стороны:  
 
                   If Abs(b(ii, 4)) > maxb Then    'если максимальное  
                       maxb2 = maxb: maxb2ind = maxbind    'запоминаем предыдущее максимальное и его положение в массиве  
                       maxb = Abs(b(ii, 4)): maxbind = ii    'запоминаем  максимальное и его положение в массиве  
                   End If  
 
                   If Abs(b(ii, 4)) <> maxb Then    ' отсекаем обработку первого максимального  
                       If Abs(b(ii, 4)) > maxb2 Then    'если второе максимальное  
                           maxb2 = Abs(b(ii, 4)): maxb2ind = ii    'запоминаем  максимальное и его положение в массиве  
                       End If  
                   End If  
 
                   If Abs(b(ii, 5)) > maxbmy Then    'если максимальное  
                       maxbmy2 = maxbmy: maxbmy2ind = maxbmyind    'запоминаем предыдущее максимальное и его положение в массиве  
                       maxbmy = Abs(b(ii, 5)): maxbmyind = ii    'запоминаем  максимальное и его положение в массиве  
                   End If  
                   If Abs(b(ii, 5)) <> maxbmy Then    ' отсекаем обработку первого максимального  
                       If Abs(b(ii, 5)) > maxbmy2 Then    'если второе максимальное  
                           maxbmy2 = Abs(b(ii, 5)): maxbmy2ind = ii    'запоминаем  максимальное и его положение в массиве  
                       End If  
                   End If
 
 
 
#19
11.10.2010 11:43:34
Хм...мне кажется, что у нас одно и тоже написано, только мы по разному отсекаем maxb...а в моем коде просто ошибка была в 6ой строке:  
maxb2 = Abs(b(ii, 4)): maxbind = ii  
а должно быть:  
maxb2 = Abs(b(ii, 4)): maxb2ind = ii  
И тогда все получается...  
 
Скажите еще пожалуйста, вот эта строка  
maxb2 = Abs(b(ii, 4)): maxb2ind = ii  
это тоже самое что две строки:  
maxb2 = Abs(b(ii, 4))  
maxb2ind = ii  
?  
 
И еще вопросик...  
For ii = 1 To UBound(b)  
Здесь не должно быть случаем  
For ii = 1 To (UBound(b)-1)  
а то он мне иногда пишет subscript out of range или что-то такое... )
 
 
 
#20
11.10.2010 11:53:25
Да, двоеточие объединяет строки, так бывает удобнее группировать связанные действия.  
По поводу For ii = 1 To UBound(b) - посмотрите в отлfдчике, какое значение в этот момент принимает ii. Я думаю, что ii не выходит за границы, а причина в другой переменной, может перепутано типа b(i,1) вместо b(ii,1).
 
 
 
#21
14.10.2010 13:10:55
Hugo! Спасите! )))    
Итак, все у меня готово, все фенечки сделаны...  
но есть какой-то внутренний косяк, и я понять совершенно не могу, почему он возникает...  
Точнее я понимаю почему он возникает, но с чем это может быть связано - понять совершенно не могу ((    
С заполнением желтых строк - все отлично. А вот заполнение зеленых строк зависит от положения искомой строки в базе данных. Почему-то получается, если требуемая строка является первой в рассматриваемом массиве, то скрипт выдает мне какую то чушь:  
Скрипт предполагает запоминание трех максимальных значений, и потом выборку из них оптимального, а в результатом почему то является четвертый максимум... (    
 
Что поделать не знаю! Может примерно подскажите в каком направлении копаться?  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#22
14.10.2010 13:29:26
Файл взять успел.  
Кода много.  
Смотрю...
 
 
 
#23
14.10.2010 13:38:03
ситуация кажется немного прояснилась )  
Ошибка кроется где то на этапе "сравниваем суммы"...  
 
Если убрать коэффициенты, из проверочных условий, то скрипт работает стабильно, независимо от положения строк...    
Но мне нужны эти коэффициенты.    
Суть как раз в том, что бы выбрать 3 максимальных значения из базы данных по одному условию, а затем по другим критериям из трёх максимальных выбрать искомое...
 
 
 
#24
14.10.2010 14:25:24
В 174 строке правильно? :)  
Вот это  
               If (0.1 * Abs(b(maxbind, 4)) + Abs(b(maxbind, 5)) + Abs(b(maxbind, 6))) > (0.1 * Abs(b(maxbm3ind, 4)) + Abs(b(maxbm3ind, 5)) + Abs(b(maxbm3ind, 6))) Then  
 
там не надо maxbmind?
 
 
 
#25
14.10.2010 14:39:09
Жесть (((    
это было проверено на 20 раз...потрачен целый день... ((( чертова невнимательность!  
 
Спасибо Вам огромное!
 
 
 
#26
14.10.2010 14:42:36
Легко выявил в Notepad++ - там при клике на слове подсвечиваются все такие слова.  
Так легко увидеть сбой порядка переменных, если можно так сказать :)
 
 
 
#27
14.10.2010 15:08:56
Век живи век учись! хороший прием )    
у меня правда возникало желание заменить все эти "maxbm3ind...maxm3ind" на что-то более читаемое типа "x3...y3", но лень пересилила...видимо зря )    
 
Сижу оцениваю результат, с тем что было выбрано раньше "ручным" методом! После проверки 100 значений ни одного сбоя, зато отлавливаются неучтенные опасные сочетания. Я в восторге! )
 
 
 
#28
14.10.2010 15:21:08
Красивый код получился, аккуратный такой :)  
А переменные мне и самому не нравятся, но так сначала начал - думал не о переменных, а об алгоритме, наспех буквы добавлял, чтоб отличались :)  
Так теперь заменой поменяйте.
 
 
 
#29
14.10.2010 15:44:39
нет уж! )    
пускай остаётся! как "наследие автора", на память! )
 
 
 
#30
17.10.2010 08:54:50
А можно ли как нибудь огразиновать выборку по диаграмме? )  
В каждом конкретном случае у меня есть область, имеющая 6 нижних значений и 6 верхних.    
Надо что бы полученные нами N, My, Mz он сверял со значениями диаграммы, и если они попадают в эту область, он записывал идентификатор диаграммы, если не удовлетворяется, переходил к следующей.  
   
Это вообще возможно? ) Диаграммы хитрые, как их вообще описать математически не понимаю...
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх