Страницы: 1
RSS
Макрос для подстановки формулы из ячейки
 
Добрый день, уважаемые планетяне,

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

Суть проблемы: написал макрос(qq) который по определенным критериям находит формулу на соседнем листе и должен бы ее перекидывать на рабочий лист. Но этого не происходит. Если я все правильно понял, то либо  при выполнении процедуры неправильно берется значение InStr (но при попытке сделать InStr-1 получаю RunTime Error 5), либо в том, что он не видит первые апострофы.

Я бы и дальше сидел рылся, искал, где ошибка, если бы до этого не сделал бы упрощенный вариант, в котором строка формулы берется из второй справа ячейки, в нем все работает: и InStr+1 и апострофы все находятся.

Макрос, который должен работать, но не работает:
Код
Sub qq()
Dim formula, Pos, Name, Div As String
Dim RSal, CSal, RMot, CMot As Integer
Sheets("Файл ЗП").Activate
For RSal = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Pos = Cells(RSal, 1).Value
    For CSal = 3 To 4
    Div = Cells(1, CSal).Value
    RMot = Application.Match(Pos, Worksheets("Мотивации").Range("A1:A1000"), 0)
    CMot = Application.Match(Div, Worksheets("Мотивации").Range("A1:AAA1"), 0)
    formula = Mid(Worksheets("Мотивации").Cells(RMot, CMot).FormulaR1C1, InStr(1, Worksheets("Мотивации").Cells(RMot, CMot).FormulaR1C1, Chr(39), vbTextCompare) + 1, 1000)
    Cells(RSal, CSal).FormulaR1C1 = formula
    Next CSal
Next RSal
End Sub

Макрос, который работает
Код
Sub q()
Dim formula As String
formula = Mid(ActiveCell.Offset(0, 2).FormulaR1C1, 1 + InStr(1, ActiveCell.Offset(0, 2).FormulaR1C1, "'", vbTextCompare), 1000)
ActiveCell.FormulaR1C1 = formula
End Sub

В чем дело не пойму :sceptic:

Ссылка на файл: https://dropmefiles.com/JzF98
Как сюда прикрепить пример тоже не разобрался
Изменено: KEKIs - 15.04.2019 13:44:30
 
UPD
Я продолжил, пока просто прописал начало со второго знака.
Обнаружено следующее (мало ли кому еще такое извращение пригодится): макрос выдает ошибку, если в формуле есть десятичные дроби (0,01), все проходит как по маслу, если использовать % (1%). Очевидно проблема в том, что VBA считает разделитель разрядов частью синтаксиса.

Пробовал менять в поиске позиции апострофа "'" на chr(39), не помогло
 
Цитата
KEKIs написал: ничего лучше кроме как подтягивать макросом формулы с соседнего листа я не придумал (подозреваю, что решение довольно кривое, но как по-другому не знаю)
Опишите саму ЗАДАЧУ, а не СПОСОБ (как Вы сами определили - кривой), которым Вы пытаетесь ее решить.
Только не пишите, что задача это ОПТИМИЗИРОВАТЬ файл.
Покажите в файле Как есть - Как надо
Цитата
KEKIs написал: Как сюда прикрепить пример тоже не разобрался
Согласие есть продукт при полном непротивлении сторон
 
KEKIs, лучше словами объясните, что должен делать макрос или формулы. Невозможно понять, что Вам нужно, из неработающего макроса и неработающих формул в файле.
Цитата
KEKIs написал: Как сюда прикрепить пример тоже не разобрался
Ссылка Загрузить файлы внизу окна ввода сообщения.
Изменено: Казанский - 17.04.2019 11:59:11
 
Цитата
KEKIs написал:
... и дальше сидел рылся, искал, где ошибка, если бы до этого не сделал ...

Сначала организуйте свой код, установте любые (какие-нибудь) теги (хотя бы Debug.Print), которые будут собирать характерные данные для дальнейшего анализа, и только потом "начинайте паниковать" ...  ;)

Например:

Код
Option Explicit

Sub qq()
    Dim shtFEP As Object
    Dim CSal As Integer
    Dim RSal As Long
    Dim frmla As String, frmlaRC As String
    Dim Pos, Div, RMot, CMot, yest
    
    Set shtFEP = ThisWorkbook.Sheets("Fayl EP")
    
    shtFEP.Activate
    
    For RSal = 2 To shtFEP.Cells(shtFEP.Rows.Count, "A").End(xlUp).Row
        Pos = shtFEP.Cells(RSal, "A").Value: Debug.Print Pos
        
        For CSal = 3 To 4
            Div = shtFEP.Cells(1, CSal).Value: Debug.Print Div
            
            With Worksheets("Motyvatsii")
                RMot = Application.Match(Pos, .Range("A1:A1000"), 0): Debug.Print RMot
                If IsError(RMot) Then MsgBox "Oshibka dlya 'Match-RMot'": Exit Sub
                
                CMot = Application.Match(Div, .Range("A1:AAA1"), 0): Debug.Print CMot
                If IsError(CMot) Then MsgBox "Oshibka dlya 'Match-CMot'": Exit Sub
                
                With .Cells(RMot, CMot)
                    frmlaRC = .FormulaR1C1: Debug.Print frmlaRC
                    yest = InStr(1, frmlaRC, Chr(39), vbTextCompare): Debug.Print yest
                    If yest = Null Then MsgBox "Oshibka dlya 'InStr-FormulaR1C1'": Exit Sub
                    
                    yest = yest + 1: Debug.Print yest
                    frmla = Mid(frmlaRC, yest, 1000): Debug.Print frmla
                End With
                
                shtFEP.Cells(RSal, CSal).FormulaR1C1 = frmla
            End With
        Next
    Next
    
    Set shtFEP = Nothing
End Sub

и так далее ...

Прикрепите адекватную формулу (в виде текста) для анализа.

Изменено: ocet p - 15.04.2019 18:50:02
 
Цитата
Sanja написал: Опишите саму ЗАДАЧУ
Дано:
есть файл по расчету ЗП (в примере лист "Файл ЗП". Сама ЗП формируется из суммы по 27 столбцам (в примере для упрощения 2 - ОП, ОДП). Значения в каждой ячейке зависят от системы оплаты труда (она может быть одинаковая для всех сотрудников на должности, а может быть разная. В примере взял 3 должности). Сейчас она существует в виде нескольких текстовых документов. И, наконец, есть отчет по сделкам (в примере лист "Отчетп о сделкам", извините), исходя из которого, используя определенную систему мотивации можно посчитать зарплату конкретного сотрудника.

Как сейчас:
два человека сидят и пол месяца считают на кулькуляторе все вручную.

Сложности:
систем мотивации куча (только должностей около 200, а еще есть те, что зависят от ФИО) и они постоянно меняются, то есть возможности написать формулу с кучей вложенных функций не получится, а администрировать ее при изменениях еще сложнее. Большое число правок по "Отчету по сделкам" в период расчета, да и кол-во сотрудников тоже частенько меняется

Что придумал я:
все мотивации хранить в виде формул на отдельном листе (в примере лист Мотивации). Далее при расчете макросом подтягивать формулу в формате r1c1  в определенную ячейку на лист Файл ЗП. Как по мне, администрировать такой реестр систем оплаты труда куда легче, чем тестовый документ.

Пример для файла пример:
Менеджер ОП получает 10% от выручки, причем эта сумма должна попадать в столбец ОПН. Итого: в ячейке С2 на листе должна появляться формула
=СУММЕСЛИМН('Отчетп о сделкам'!$B:$B;'Отчетп о сделкам'!C:C;"оп")*10%.
На листе мотиваций эта же мотивация будет выглядеть следующим образом:
'=sumifs('Отчетп о сделкам'!C2,'Отчетп о сделкам'!C,"оп")*10%
Чтобы ее смог использовать VBA. Апостроф вначале, чтобы excel в принципе разрешил такое в ячейке хранить

В чем вопрос:
Сначала я пытался забрать мотивациюvиз ячейки через .formulaR1C1, но для этого нужно было убрать апостроф. InStr (11 строчка) находил только третий апостроф, вне зависимости от того, как я его писал: так "'" или так chr(39).
Сейчас я забираю мотивацию через .value что избавляет меня от необходимости убирать апостроф и дает возможность настроить автоматическое формирование мотиваций (буду сцеплять из разных частей итоговую формулу)
Но вопрос с апострофом меня все равно очень интересует, да и решение менее корявое может быть кто-то сможет предложить  
В фале два макроса - новый и старый - новый работает, старый нет

Цитата
Казанский написал:
лучше словами объясните, что должен делать макрос или формулы. Невозможно понять, что Вам нужно, из неработающего макроса и неработающих формул в файле.
Постарался изложить как можно более ясно )
Цитата
ocet p написал:
Сначала организуйте свой код, установте любые (какие-нибудь) теги (хотя бы Debug.Print)
Я в макросы пока только учусь. Пару месяцев примерно, такого не знаю) Спасибо за подсказку, буду разбираться что к чему)
 
Вот от этого я Вас и предостерегал. Вы все свое повествование построили на том как Вы боролись со своими формулами.
Попробую еще раз. Опишите ЗАДАЧУ так, как ее поставило Вам ваше руководство, которое ничего не знает о формулах, об, упаси Господи, макросах и Excel для них набор бессмысленных английских букв.
В файле приведите несколько строк (15-20) исходных данных по всем видам мотиваций/фамилий/должностей и результат, вычисленный хоть вручную, хоть с помощью формул, и опишите сам процесс этого вычисления. НЕ ФОРМУЛОЙ!
Согласие есть продукт при полном непротивлении сторон
 
цитирование - не бездумное копирование сообщений [МОДЕРАТОР]

Мне показалось, я именно так и сделал... Задача от руководства: "Сейчас два сотрудника на протяжении 15 дней считают зарплату. Нужно сократить время, уменьшить кол-во ошибок." Вы правильно заметили, что способ реализации: макросы, формулы или магия - им не важно. Пример данных в файле тоже есть: модель итоговой таблицы с ЗП с двумя должностями и двумя промежуточными столбцами. Исходная таблица: два отдела. Моделируемые мотивации:
1. Менеджер ОП - 10% от выручки по сделке ОП
2. Менеджер ОДП - 10% от своей выручки ОДП и 1% от общей суммы выручек ОДП
3. Руководитель - 1% от всей выручки вне зависимости от отдела
Так вот, условный бух по ЗП каждый месяц садится и все это на калькуляторе считает. Руководству хочется по-другому. Я придумал как придумал, и в принципе макрос "Новый" здесь свою работу выполняет. А заключается она в следующем: в зависимости от должности он подтягивает определенные формулы для расчета ЗП с отдельного листа. Как на таких объемах сделать иначе - я не знаю.

Изначально вопрос был в другом: почему InStr  думает, что в строке
'=sumifs('Отчетп о сделкам'!C2,'Отчетп о сделкам'!C,"оп")*10%
Первый апостроф находится на 9 позиции?
Понять мне помогла проверка предложенная ocet p, неважно, как забирать текстовую строку из ячейки: через .Value  или .FormulaR1C1, первый апостроф все равно пропускается. За подсказку возможности такой проверки огромное спасибо!
 
Потому что "такие" функции не видят символы форматирования.
Апостроф используется для преобразования данного значения в текст.
Выполнийте (через F8) "экспериментальный код" ниже, затем прочитайте о "PrefixCharacter".
Код
Option Explicit

Sub abc_xyz()
    Dim statusTNK
    
    statusTNK = Application.TransitionNavigKeys
    Application.TransitionNavigKeys = False
    
    Range("A1:D1").ClearContents
    Range("A1").Value = "'=C1+D1"
    Range("C1").Value = 1
    Range("D1").Value = 2
    
    If "'" = Range("A1").PrefixCharacter Then
        Range("B1").Formula = Range("A1").Value
    End If
    
    Application.TransitionNavigKeys = statusTNK
End Sub

редакт.:

Не было бы лучше воссоздать ваши формулы из кода VBA или из листа, но без апострофов ?
Пример ниже:
Изменено: ocet p - 16.04.2019 23:02:02
 
KEKIs,не знаю, актуально ли еще, но можно попробовать через диспетчер имен решить задачу.
Прикладываю, как бы я реализовал этот файл.
Хоть макросы я здесь и не использую, но файл все равно должен быть в формате .xlsm.
Изменено: Valo - 16.04.2019 23:56:26
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
ocet p, спасибо, за подсказки! Администрировать мотивации в коде VBA довольно сложно, как по мне, а вот хранить их без апострофов мне почему-то в голову не пришло. Единственное, что хранить и вставлять их нужно будет тоже в формате R1C1, потому что при добавлении новых должностей строк возникают ошибки.

Valo, это какая-то магия. Я еще не до конца разобрался, но, возможно, это действительно более хорошее решение. Пока не понимаю, как новые мотивации прописывать, я правильно понимаю, что к ним формулы Вы писали в формате R1C1?
 
KEKIs, формулы писал в обычном формате.
Допустим я хочу добавить формулу расчета зарплаты для должности - Директор:
1. На листе Формулы добавляю Директор в столбец Должность
2. Пишу название формулы для ОПН - Дир_ОПН
3. Пишу название формулы для ОПН - Дир_ОДП
4. Захожу в диспетчер имен и создаю формулы расчета с именем Дир_ОПН
5. Сама формула допустим будет выглядеть так:
Код
=0,5*СУММ('Отчетп о сделкам'!$B:$B)
Обязательно закрепляем столбцы.

5. Захожу в диспетчер имен и создаю формулы расчета с именем Дир_ОДП
6. Сама формула допустим будет выглядеть так:
Код
=0,3*СУММ('Отчетп о сделкам'!$B:$B)
Обязательно закрепляем столбцы.

6. Пишу на листе Файл ЗП должность Директор и протягиваю формулы.

Формулы Выч_ОП и Выч_ОДП работают так:
С помощью ВПР ищется название формулы в таблице на листе Формулы для соответствующей должности. Выч_ОП берет название из 2 столбца, Выч_ОДП из 3 столбца. Далее с помощью функции Вычислить - происходит расчет формулы с этим названием в диспетчере имен.
Изменено: Valo - 17.04.2019 17:47:35
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Valo, Благодарю!
Я до этого я в принципе смог дойти) Вопрос в том, как записывать формулу в диспетчер, если условие находится в 1 или 2 столбце, как в моем случае с Петровым.

Сумма в ячейке D3 зависит от содержимого B3, в диспетчере у Вас ячейка указана явно. Но при протяжке вниз условная ячейка меняется на B4, в т.ч. в диспетчере (У Вани нет сделок)
Не понимаю, как указывать условие, только в r1c1 получилось. Не подскажете?)
Изменено: KEKIs - 17.04.2019 18:42:32
 
Цитата
KEKIs написал:
(У Вани нет сделок)
Но 1% от общей суммы же надо считать?

Опишите еще как для бухгалтера считается зарплата.
Изменено: Valo - 17.04.2019 17:57:48
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Valo, именно, считает все правильно)
Не понимаю, как в диспетчер имен со стилем ячеек A1 внести формулу, условие для которой находится в соседней. Какой номер строки использовать?)
 
KEKIs, строку использовать ту,  которая в данный момент активна.
Проще всего сначала написать формулу в нужной ячейке, посмотреть как она будет работать при протягивании, а затем эту формулу скопировать в диспетчер имен.
Изменено: Valo - 17.04.2019 18:01:10
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
Valo, Разобрался! Спасибо огромное!
Страницы: 1
Наверх