Страницы: 1
RSS
Таблица по хомячку с выпадающими списками, сортировкой и добавлением новых данных
 
Здравствуйте! Пока все тапают на хомяка и решают автоматизацию кликов, я решил создать таблицу по выдаче самого выгодного вложения в предприятия.
Прикладываю таблицу, которую смог сделать на данный момент, но я так и не нашёл способ автоматизации протягивания формул.Идея такая: в умной таблице можно выбрать уровень из тех, что имеется у конкретного предприятия в базе Данных, таблица автоматически подтянет данные по Price, Profit и PPM (PPM высчитывается по формуле Profit / Price), когда все уровни выбраны, отфильтровать PPM по убыванию, прокачать это предприятие в Хомяке, ввести новые данные в базу данных, в таблице изменить уровень на новый (в идеале, если бы уровень менялся на новый автоматически, но с возможностью выбора ), и показать самое выгодное предприятие уже на основе новых данных, и так бесконечно.

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

Выбор уровня я сделал так: сформировал умную таблицу, в ячейке lvl - данные, проверка данных, тип данных "список", указываю вручную диапазон =Данные!$N$2:$N$16, жму ОК. На данный момент, весь диапазон пустой, кроме первой строчки. Это нужно для того, чтобы при добавлении новых строк уровней с данными в выпадающем списке автоматически отображались новые уровни. 2 примечания - список всё равно отображает даже пустые ячейки - это неудобно, и хочется именно диапазон из конкретного места, а не просто уровни с 1 по 20. Следующий диапазон находится на 6 столбцов правее. Допустим, я вручную прописал 5 строчек с уровнями вниз, логика видна, но если начать протягивать формулу, то Excel абсолютно не понимает, что там за логика и внедряет свою. Как автоматизировать растягивание даже со смещением - я не смог понять

Вторая проблема - это ВПР в умном списке. Сейчас 1 ячейка с динамическими данными, привязанными на уровень, выглядит так - =ВПР([@lvl];СМЕЩ(Данные!$N$2:$Q$16; 0; (СТРОКА(A2)-2)*6); 2; ЛОЖЬ)
Сначала не было смещения, а, как и сверху, просто указан диапазон, повторён 5 раз, но при растягивании применялась стандартная логика сдвига строчки вниз и всё. Excel не понял, что нужно указывать каждые 6 столбцов вправо с каждой новой строкой. Тогда  написал формулу для растягивания вниз с ручным смещением вправо на 6 столбцов. Ура! Оно заработало, но только до тех пор, пока я не применил фильтрацию PPM по убыванию - все формулы полетели, список переиначился, а каждая растянутая формула, чётко основывавшаяся на предыдущей, перестала понимать, откуда теперь брать данные


Вот такая последовательность требуется
=ВПР(Таблица[@lvl];Данные!N2:Q16;{2};0)
=ВПР(Таблица[@lvl];Данные!T2:W16;{2};0)
=ВПР(Таблица[@lvl];Данные!Z2:AC16;{2};0)
=ВПР(Таблица[@lvl];Данные!AF2:AI16;{2};0)
=ВПР(Таблица[@lvl];Данные!AL2:AO16;{2};0)
итд

Прописав вручную ячейки, растянув вниз применилась логика N3:Q17 N4:Q18 итд, когда нужно было смещение на 6 столбов вправо, но с чётким указанием диапазона, чтобы каждая ячейка знала, к чему отсылаться при разном расположении в строках таблицы

Буду рад любой помощи - от идеи по переделыванию изначального вида Данных, чтобы проще было создать таблицу, до буквальных кликов, как растянуть проверку данных и формулу ВПР. Приложил поломанную таблицу, если я плохо всё объяснил

Версия 2108, Microsoft Office LTSC профессиональный плюс 2021
Изменено: noanstop - 11.06.2024 15:11:49
 
Переделал вид исходных данных: видел в комментариях, что лучше вертикально данные располагать.
Для каждого наименования теперь нужно создавать отдельный список с уровнями? LVL_Fan_Tokens, LVL_Staking ит.д.? И в каждый блок наименования дублировать шапку? Иначе, при создании таблицы, верхнюю строчку он хочет превратить в выпадающее меню
С растягиванием формулы такая компоновка не помогла - всё равно по одной строке передвигается
 
Много слов, а вот название темы не отражает сути
Можно было просто: Поиск в той же строке со сдвигом искомого
=ИНДЕКС(Данные!$O$2:$EM$2;ПОИСКПОЗ(C2;Данные!$N$2:$EL$2;))
 
4 дня разговоров с чатомжопт не дали мне полностью реализованный результат, но криво-косо в ручном режиме таблица всё-таки заработала. прикладываю скрины последнего из десятка разговоров, которые дали хоть какой-то результат. На скрине видно, как теперь выглядит таблица
Что не реализовано:
1. Списки LVL имеют фиксированные значения от 0 до 20, а не адаптивные, берущие информацию из базы данных с уровнями наименований.
2. Обновление списка происходит не автоматически, а по скрипту и по нажатии кнопки "Обновить".
3. Фильтрация списков не обновляется автоматически после изменения значений и обновления списка: нужно фильтровать вручную, даже если фильтр уже установлен.
4. LVL в таблице не подтягивает автоматически новые строчки данных в базе. Получил новый уровень, копируешь предыдущую строку необходимого наименования, заменяешь старые значения на новые, идёшь в таблице, вручную указываешь уровень из предустановленных 20, жмёшь обновить список, жмёшь фильтрацию, и только тогда получишь необходимый результат. Это очень долго и неудобно.
5. Тут уже сложнее. Мне пришлось дать каждому имени нумерацию, чтобы была возможность отфильтровать по тому же принципу, что они располагаются в самом Хомяке. Так удобнее переносить информацию и в самой игре спускаться сверху вниз, как и в таблице. Но, если в игре появится новое наименование, которое встрянет куда угодно, то в таблице мне придётся вручную переписывать нумерацию с того места, куда пришла новая карта, и до самого конца. Процедура повторяется в таблице и базе данных, потому что если изменить имя в одном месте, то обновление списка перестанет работать - все имена должны совпадать
6. Пропала прикольная анимация перебора циферок, когда появляется новое значение, но это уже совсем мелочь

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

Вот все коды, которые чат мне прислал
=ВПР($C2&$B2&$A2; СЦЕПИТЬ(Database!$C$2:$C$100&Database!$B$2:$B$100&Database!$A$2:$A$100); Database!$D$2:$D$100; 4; ЛОЖЬ)
=ЕСЛИОШИБКА(ИНДЕКС(Database!$D$2:$D$100; ПОИСКПОЗ(1;($C2=Database!$C$2:$C$100)*($B2=Database!$B$2:$B$100)*($A2=Database!$A$2:$A$100); 0)); "")
=ЕСЛИОШИБКА(ИНДЕКС(Database!$E$2:$E$100; ПОИСКПОЗ(1;($C2=Database!$C$2:$C$100)*($B2=Database!$B$2:$B$100)*($A2=Database!$A$2:$A$100); 0)); "")
=ЕСЛИОШИБКА(ИНДЕКС(Database!$F$2:$F$100; ПОИСКПОЗ(1;($C2=Database!$C$2:$C$100)*($B2=Database!$B$2:$B$100)*($A2=Database!$A$2:$A$100); 0)); "")
=ЕСЛИОШИБКА(ИНДЕКС(Database!$G$2:$G$100; ПОИСКПОЗ(1;($C2=Database!$C$2:$C$100)*($B2=Database!$B$2:$B$100)*($A2=Database!$A$2:$A$100); 0)); "")

И макрос на обновление таблицы
Sub UpdateTable()
   Dim ws As Worksheet
   Dim db As Worksheet
   Dim lastRow As Long
   Dim dbLastRow As Long
   Dim i As Long
   Dim j As Long
   Dim matchFound As Boolean
   
   Set ws = ThisWorkbook.Sheets("Table")
   Set db = ThisWorkbook.Sheets("Database")
   lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   dbLastRow = db.Cells(db.Rows.Count, "A").End(xlUp).Row

   For i = 2 To lastRow
       matchFound = False
       For j = 2 To dbLastRow
           If ws.Cells(i, 1).Value = db.Cells(j, 1).Value And _
              ws.Cells(i, 2).Value = db.Cells(j, 2).Value And _
              ws.Cells(i, 3).Value = db.Cells(j, 3).Value Then
             
               ws.Cells(i, 4).Value = db.Cells(j, 4).Value
               ws.Cells(i, 5).Value = db.Cells(j, 5).Value
               ws.Cells(i, 6).Value = db.Cells(j, 6).Value
               ws.Cells(i, 7).Value = db.Cells(j, 7).Value
               matchFound = True
               Exit For
           End If
       Next j
       
       If Not matchFound Then
           ws.Cells(i, 4).Value = "Нет данных"
           ws.Cells(i, 5).Value = "Нет данных"
           ws.Cells(i, 6).Value = "Нет данных"
           ws.Cells(i, 7).Value = "Нет данных"
       End If
   Next i
End Sub
 
2. Исправлено.
VBA, лист с таблицей и выпадающими списками:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim ws As Worksheet
   Dim db As Worksheet
   Dim lastRow As Long
   Dim dbLastRow As Long
   Dim i As Long
   Dim j As Long
   Dim matchFound As Boolean
   
   Set ws = ThisWorkbook.Sheets("Table")
   Set db = ThisWorkbook.Sheets("Database")
   lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   dbLastRow = db.Cells(db.Rows.Count, "A").End(xlUp).Row

   ' Проверяем, изменились ли значения в колонке "lvl" (например, колонка C)
   If Not Intersect(Target, ws.Range("C2:C" & lastRow)) Is Nothing Then
       Application.EnableEvents = False ' Отключаем события для предотвращения зацикливания
       
       For Each cell In Target
           matchFound = False
           For j = 2 To dbLastRow
               If cell.Value = db.Cells(j, 3).Value And _
                  ws.Cells(cell.Row, 2).Value = db.Cells(j, 2).Value And _
                  ws.Cells(cell.Row, 1).Value = db.Cells(j, 1).Value Then
                 
                   ws.Cells(cell.Row, 4).Value = db.Cells(j, 4).Value
                   ws.Cells(cell.Row, 5).Value = db.Cells(j, 5).Value
                   ws.Cells(cell.Row, 6).Value = db.Cells(j, 6).Value
                   ws.Cells(cell.Row, 7).Value = db.Cells(j, 7).Value
                   matchFound = True
                   Exit For
               End If
           Next j
           
           If Not matchFound Then
               ws.Cells(cell.Row, 4).Value = "Нет данных"
               ws.Cells(cell.Row, 5).Value = "Нет данных"
               ws.Cells(cell.Row, 6).Value = "Нет данных"
               ws.Cells(cell.Row, 7).Value = "Нет данных"
           End If
       Next cell
       
       Application.EnableEvents = True ' Включаем события снова
   End If
End Sub

3. Исправлено.
Добавить код в конце между Next cell и Application.EnableEvents = True ' Включаем события снова

   ' Автоматическая сортировка по PPM (столбец G)
       ws.Sort.SortFields.Clear
       ws.Sort.SortFields.Add Key:=ws.Range("G2:G" & lastRow), _
           SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
       With ws.Sort
           .SetRange ws.Range("A1:G" & lastRow)
           .Header = xlYes
           .MatchCase = False
           .Orientation = xlTopToBottom
           .SortMethod = xlPinYin
           .Apply
       End With
Изменено: noanstop - 03.07.2024 16:01:22
Страницы: 1
Наверх