Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Станислав Воротынцев
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
ToDo List (VBA), Просто проектик на прожарку)
 
#
27.05.2024 14:40:15
Доброго времени суток, уважаемые Форумчане!)
Собственно, просто хотел узнать мнение мастеров и может подслушать пару интересных идей и фич VBA.
Во вложении маленький проект простого ТуДу-листа, реализованного в Excel. Буду рад комментариям что доработать, как лучше писать - оформлять код и просто небольшому тестированию.
На самом деле тут хотелось понять и обкатать логику взаимодействия с умными таблицами.
В проекте использовал функцию сортировки массива(coolsort), остальное уже моё.
функционал:
- на листе Planned_task вписываем задачи Дату начала и Дедлайн, а также из выпадающего списка выбираем приоритет;
- жмем кнопку "Обновить список задач"
- на листе ToDo отобразятся задачи отсортированные по Дедлайну и приоритету
   - активные задачи можно пометить в поле Отметка "В работе" в этом случае при добавлении новых задач отмеченная будет добавляться с этой же отметкой и станет еще одним фильтром в сортировке задач
   - Если поставить отметку "Выполнено" задача будет перенесена на лист "Сompleted_tasks"
Старался не мудрить, но сделать красиво)
Буду рад обратной связи и заранее спасибо!)
 
Перейти    
При удалении Queries ломается файл, Возникла проблема при удалении запросов PQ с помощью VBA. Нужен совет как поймать ошибку)
 
#
22.05.2024 16:18:00
И снова здравствуйте, форумчане!
Возникла проблема при удалении запросов Power Pivot с помощью VBA (сам макрос находится в 1 книге, а wb_bill - это уже другой файл, который открывается, редактируется из 1-го), используя простой скрипт:
Код
Dim query_con As WorkbookQuery
For Each query_con In wb_bill.Queries
    query_con.Delete
Next
wb_bill.Save
wb_bill.Close
При открытии этого файла(wb_bill) возникает следующая ошибка: "Ошибка1" (из вложения) и единственная информация которой я располагаю после открытия файла это адрес битой таблицы и xml файле, в который совсем не хочется лезть("Ошибка2"). Причем данная ошибка перемещается вслед за этим куском кода.
К сожалению, не могу скинуть пример файла, ибо обезличть его уже очень тяжело будет, и знаю, что без примера тяжело понять чего хочет очередной болванчик вопрощающий, но подскажите, в каком направлении двигаться)
Важный момент:
данная ошибка возникает только при работе из другой книги. В самой книге все работает штатно.
Заранее спасибо!
Изменено: Станислав Воротынцев - 22.05.2024 16:28:20
 
Перейти    
Получение данных умной таблицы в UserForm, Не могу отловить ошибку в одной форме все работает отлично, в другой такая же конструкция не работает.
 
#
11.04.2024 16:12:23
Всех приветствую и в очередной раз прошу помощи у уважаемого сообщества!)
Вопрос не по работе, так сказать, а творческий, но все же, на данном проекте учусь с Userform обращаться.
Это простенький игровой проект, чтобы поддержать интерес к программированию у младшего брата, но столкнулся с ошибкой "451 - объект не является коллекцией", но есть нюанс, как говорится.

Есть следующая конструкция:
Код
Set ws = ThisWorkbook.Sheets("Главы")
    Set listObj_story = ws.ListObjects("story_chapter")
    Set found_value = listObj_story.DataBodyRange.Columns(1).Find(Me.tb_prev_chapt.Value, _
        LookIn:=xlValues, lookat:=xlWhole)
        
    story_text = listObj_story.DataBodyRange.Formula(found_value.row - 1, found_value.Column + 1)
в форме uf_story_telling и она работает прекрасно:
в Find() передается число, соответствующее номеру строки в умной таблице на листе "Главы", found_value возвращает позицию в таблице и с помощью .DataBodyRange.Formula(int, int) я достаю нужные мне данные.

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

Для того чтобы произвести ошибку нужно на листе "Лист Путешественника" нажать кнопку "Показать меню" -> "Начать новую игру" и в открывшейся форме(как указано на рис.1 ) вбить "5", после этого нажать перейти. В обновившейся форме нажать кнопку "в бой" правая нижняя красная кнопка))) и при инициализации формы uf_enemy_char_list и происходит данная ошибка.

Буду признателен за помощь)

P.S.: А игра классная, я сам в нее в детстве рубился))
 
Перейти    
Ошибка " method range of object _global failed" при копировании файла, При работе макроса возникает ошибка, при переходе в VBE и нажатии кнопки RUN макрос срабывает штатно.
 
#
23.11.2023 12:57:45
Коллеги, добрый день!
Данный макрос создает копию основного листа сохраняет его в отдельной папке как книгу и добавляет листом в другую книгу. Файл содержит умные таблицы, при нажатии на кнопку "Отправить" на строке в основном(большом) блоке WITH:
Код
n_wb.Sheets("Форма_счет").Range("Входящие_файлы_СЧЕТА[[#Headers],[Наценка на цену Конкурента]]").ListObject.ListColumns.Add
возникает ошибка "1004 method range of object _global failed", по при переходе в VBE по кнопке Debug и нажатии RUN все продолжает работать штатно.

Нашел тему с такой же ошибкой, где проблема была в глобальной переменной, но я не использовал данный тип переменных ( хотя была идея, но я отказался). Прошу помочь разобраться и поймать ошибку.
Заранее спасибо.
Код
Sub send_for_coordination()

    Dim wb, n_wb, wb_cost As Workbook
    Dim ws As Worksheet
    Dim lr, i As Long
    Dim count As Long
    Dim markup_StS As Currency
    Dim price_Comp As Currency
    Dim price_StS As Currency
    Dim sum_markup_StS As Currency
    Dim sum_price_Comp As Currency
    Dim sum_price_StS As Currency
    Dim file_name, my_path, cost_path As String
    Dim arr As Variant
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        Call save_data
        ' инициализация объектов
        Set wb = Workbooks(ThisWorkbook.Name)
        Set ws = wb.Sheets("Форма_счет")
            
            ' инициализация имени новой книги
            my_path = wb.Sheets("ВСП").Range("path_to_save")
            file_name = ws.Range("C3") & " № " & ws.Range("E3") & " от " & ws.Range("E2") & ".xlsm"
            If Len(file_name) > 30 Then
                    file_name = ws.Range("C3") & " № " & ws.Range("E3") & ".xlsm"
            Else
                file_name = ws.Range("C3") & " № " & ws.Range("E3") & " от " & ws.Range("E2") & ".xlsm"
            End If
            ws.Copy
            ' инициализация новой книги - счета, отключаем всплывающие окна
            ActiveWorkbook.SaveAs my_path & file_name, FileFormat:=52
            ' вносим адрес книги "Для подгрузки", прячем сворачиванием столбцов
            Set n_wb = Workbooks(file_name)
                n_wb.Sheets(1).Range("O1") = wb.Sheets("ВСП").Range("path_cost_price")
                n_wb.Sheets(1).Columns("O:O").Select
                Selection.EntireColumn.Hidden = True
                n_wb.Sheets(1).OLEObjects("CommandButton1").Delete
                ' закрытие новой книги, включение всплывающих окон
                n_wb.Sheets(1).Range("C2").Select
            ' открываем файл "Для подгрузки"
            
            Application.Workbooks.Open filename:=wb.Sheets("ВСП").Range("path_cost_price[путь к данным себестоимость]")
            Set wb_cost = ActiveWorkbook
                ' В файл "для подгрузки" вставляем дату из документа
                wb_cost.Sheets("НМ").Range("C2") = ws.Range("E2")
                wb_cost.Sheets("Заявки").Activate
                    ' вносим данные на лист "Заявки"
                    With wb_cost.Sheets("Заявки")
                        .Unprotect Password:="12345w!"
                        ' последняя строка таблицы
                        lr = .Cells(Rows.count, 2).End(xlUp).Row + 1
                        ' номер по порядку
                        Range("B" & lr).Select
                        ActiveCell.Formula2R1C1 = lr - 2
                        ' создаем ссылку на документ
                        Range("C" & lr).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                        "Заявки\" & file_name & "", _
                        TextToDisplay:="Заявки\" & file_name & ""
                        ' Форматируем новую строку
                        Rows(lr & ":" & lr).Select
                        Selection.RowHeight = 30
                        Range("D" & lr).Select
                    End With

                n_wb.Sheets("Форма_счет").Activate
                n_wb.Sheets("Форма_счет").Select

                    With n_wb.Sheets("Форма_счет")
                        
                        ' Ищем себестоимость в файле "Для подгрузки"
                        Range("I5") = "Максимальная себестоимость"
                        Range("I6").Select
                        ActiveCell.FormulaR1C1 = "=IFERROR(IF(OR([@[Цена конкурента]]="""",[@[Цена конкурента]]=0),0,VLOOKUP([@Артикул],'[Себестоимость.xlsm]НМ'!C1:C7,MATCH('[Себестоимость.xlsm]НМ'!R3C7,'[Себестоимость.xlsm]НМ'!R3,0),0)),0)"
                        If Range("Входящие_файлы_СЧЕТА[Максимальная себестоимость]").Rows.count > 1 Then
                            Selection.AutoFill Destination:=Range("Входящие_файлы_СЧЕТА[Максимальная себестоимость]")
                        End If
                        Range("Входящие_файлы_СЧЕТА[Максимальная себестоимость]").Select
                        Selection.Copy
'                        Selection.NumberFormat = "#,##"
'                        Selection.PasteSpecial Paste:=xlPasteValues
'                        Selection.PasteSpecial xlPasteValues
'                        Range("Входящие_файлы_СЧЕТА[Максимальная себестоимость]").PasteSpecial xlPasteValues
                        ' расчет наценки на цену СТС
                        Range("J5") = "Наценка на цену СантехСтандарт"
                        Range("J6").Select
                        ActiveCell.FormulaR1C1 = "=IFERROR(Входящие_файлы_СЧЕТА[@Цена]/Входящие_файлы_СЧЕТА[@[Максимальная себестоимость]]-1,"""")"
                        If Range("Входящие_файлы_СЧЕТА[Наценка на цену СантехСтандарт]").Rows.count > 1 Then
                            Selection.AutoFill Destination:=Range("Входящие_файлы_СЧЕТА[Наценка на цену СантехСтандарт]")
                        End If
                        ' расчет наценки на цену конкурента
                        Range("K5") = "Наценка на цену Конкурента"
                        Range("K6").Select
                        ActiveCell.FormulaR1C1 = "=IFERROR(Входящие_файлы_СЧЕТА[@[Цена конкурента]]/Входящие_файлы_СЧЕТА[@[Максимальная себестоимость]]-1,"""")"
                        If Range("Входящие_файлы_СЧЕТА[Наценка на цену Конкурента]").Rows.count > 1 Then
                            Selection.AutoFill Destination:=Range("Входящие_файлы_СЧЕТА[Наценка на цену Конкурента]")
                        End If
                        
                         Range("Входящие_файлы_СЧЕТА[[Сумма]:[Максимальная себестоимость]]").Select
                            Selection.Copy
                            Application.CutCopyMode = False
                            Selection.Copy
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            Selection.NumberFormat = _
                                "_-* #,##0.00 _?_-;-* #,##0.00 _?_-;_-* ""-""?? _?_-;_-@_-"
                        'Range ("Входящие_файлы_СЧЕТА[Максимальная себестоимость]")
'                        Range("clmn_var").Delete
                        Range("J2:K3").Select
                        With Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                            .WrapText = True
                            .Borders.LineStyle = xlContinuous
                            .Style = "Percent"
                        End With
                        Range("J2").Interior.ColorIndex = 19
                        Range("J2") = "Наценка на счет СантехСтандарт"
                        Range("K2") = "Наценка на счет от конкурента"
                        Range("K2").Interior.ColorIndex = 19
                        

                        n_wb.Sheets("Форма_счет").Range("Входящие_файлы_СЧЕТА[[#Headers],[Наценка на цену Конкурента]]").ListObject.ListColumns.Add
'                            Selection.ListObject.ListColumns.Add
                            Range("Входящие_файлы_СЧЕТА[[#Headers],[Столбец1]]").Select
                            ActiveCell.FormulaR1C1 = "Согласованная цена"
                            Range("Входящие_файлы_СЧЕТА[Согласованная цена]").Select
                            Selection.Font.Bold = True
                            With Selection.Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent6
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        
                        arr = ActiveSheet.ListObjects("Входящие_файлы_СЧЕТА").Range
                        For i = LBound(arr) + 1 To UBound(arr)
                            If arr(i, 6) <> 0 Then
                            'If arr(i, 6) = 0 Then
                                count = arr(i, 3)
                                ' расчет себестоимости
                                markup_StS = arr(i, 8) * count
                                price_Comp = arr(i, 6) * count
                                price_StS = arr(i, 4) * count
                                sum_markup_StS = sum_markup_StS + markup_StS
                                sum_price_Comp = sum_price_Comp + price_Comp
                                sum_price_StS = sum_price_StS + price_StS
                            End If
                        Next i
                        
                        Range("J3") = sum_price_StS / sum_markup_StS - 1
                        Range("K3") = sum_price_Comp / sum_markup_StS - 1
                        n_wb.Sheets("Форма_счет").Activate
                        Range("Входящие_файлы_СЧЕТА[[Наценка на цену СантехСтандарт]:[Наценка на цену Конкурента]]").Select
                        Range(Selection, Selection.End(xlDown)).Select
                        Selection.Style = "Percent"
                    End With
                    
                    n_wb.Sheets("Форма_счет").Copy after:=wb_cost.Sheets("ВСП")
                    With wb_cost
                        .Sheets("Форма_счет").Name = wb.Sheets("Форма_счет").Range("C3") & " № 1 " & wb.Sheets("Форма_счет").Range("E3")
                    End With
                    ' сохранение и закрытие книги
                    wb_cost.Save
                    wb_cost.Close
                    n_wb.Save
                    n_wb.Close
                    
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True

            MsgBox "Запрос отправлен"
End Sub
 
Перейти    
Фильтрация столбца определяемого параметром, Необходим найти способ задать столбец для фильтрации параметром.
 
#
20.11.2023 15:33:48
Добрый день!
Давненько бьюсь над задачкой:
- есть 2 типа счетов из 1С в формате .xlsx, из которые с помощью PQ тянется нормализованная таблица с арт., наименованием, и пр. данными. Но если в одном нужное поле находится в 3-м столбце, то во втором счете данные в 5-ом столбце. Есть ли возможность передать столбец параметром в запись:
Код
= Table.SelectRows(#"Столбец расширенной таблицы1", each not List.ContainsAny({null, ""}, {[Column5]}))
т.е. вместо [Column5] задать параметр, который будет вводиться пользователем?
Стандартный (для меня) метод формата List{0} не срабатывает, что понятно вроде как понятно, PQ ругается на несоответствие типов.
есть возможность реализовать такой метод?

P.S.: Вообще уже подумываю над тем, чтобы снова вернуться к идее спарсить основные данные VBA, но все же хочется попробовать сделать именно так)
Изменено: Станислав Воротынцев - 20.11.2023 15:45:59
 
Перейти    
связать 2 диапазона на разных листах книги, необходим метод по которому 2 диапазона будут ссылаться друг на друга, с возможностью редактирования.
 
#
16.05.2023 10:16:13
Добрый день!
Бьюсь над следующей проблемой:
- есть два листа, на которых есть диапазоны, которые в теории должны ссылаться друг на друга. Т.е. при заполнении на одном листе, данные должны переноситься на другой, и наоборот.
- ранее находил метод "Intersect", который помогал запустить макрос при изменении параметра "KeyCell", полагаю, что и сейчас как-то через него надо работать, но не могу сообразить как, по прямому условию связать диапазона не получается, при вводе данные просто удаляются)

 Есть ли вообще способ через VBA настроить подобную связь двух диапазонов?
Прошу помочь наставлением на путь истинный))

Если задача окажется решаема прикреплю файл)
Заранее спасибо!
Изменено: Станислав Воротынцев - 16.05.2023 10:16:35
 
Перейти    
При переносе данных из закрытой книги всплывает ошибка, Прошу помощи в поиске ошибки в коде макроса getValue(module1)
 
#
05.10.2022 10:25:39
Есть процедура для извлечения данных из книги, но работает не корректно, возвращает #ССЫЛКА!. В файле-источнике в нужном диапазоне стоят формулы, думал из-за этого ошибка, но если ссылаться на диапазон со значениями та же ошибка. Прошу помочь разобраться с ошибкой, файл во вложении.
Заранее спасибо!

P.S.:Не хочется сильно перегружать формулу, т.к. я новичок в VBA, да и этим файлом не только я буду пользоваться.
 
Перейти    
VBA Заполнение таблицы из листов в книге, Прошу помощи в поиске ошибки в коде макроса filltable
 
#
01.10.2022 15:40:28
Коллеги, привет!
Благодаря Вашему ресурсу и поддержке решил ступить на скользкий путь VBA.
На этот раз не могу найти ошибку в коде макроса fillTable, он должен проверять листы в книге и исходя из названия листа брать с него значения из вертикального диапазона и переносить на лист "Сводная" в горизонтальный. Знаю, что есть готовые решения, но очень хочется самому разобраться.
Код работает, но как-то криво в итоге нашел только один диапазон  из 33.
Буду признателен за помощь!
Заранее спасибо!
Изменено: Станислав Воротынцев - 01.10.2022 15:58:47
 
Перейти    
как закрепить значение вычисляемой функции от последующих изменений., Желательно закрепить значение не использую макросов.
 
#
09.09.2022 14:01:26
Добрый день!
Подскажите существует ли способ закрепить вычисленное значение в ячейке от последующих изменений?
Т.е. в единожды вычислив значение его нужно защитить от дальнейших вычислений, Для примера ячейка J16 должна прекратить подсчет результата если стоит флажок в столбце D. Буду признателен если просто подскажите как сформировать запрос поиска)
Или же есть ли способ сохранить значение вычисленное в ячейке и заменить им формулу в той же ячейке?
Спасибо!
 
Перейти    
Почему сумма по указанному критерию больше, чем реальная
 
#
29.12.2021 11:58:40
Всем привет!
Подскажите почему при ссылке на другую страницу формула СУММЕСЛИ выдает неверное значение по текстовому критерию. причем при работе на отдельном куске массива все работает корректно. Не могу понять в чем проблема, "=" перед критерием тоже не помогает. Помогите найти ошибку.
Заранее спасибо!
Изменено: vikttur - 31.08.2022 21:43:48
 
Перейти    
Страницы: 1
Наверх