[Iska]

Ребят помогите пожалуйста вот эту формулу представить в виде скрипта: »

Может быть, ввести формулу в ячейку при помощи кода VBA?

Код:

Range("G3").FormulaLocal = "=Если(E3="""";B3-B3;Если(B3>E3;B3-E3;0))"

Мне, правда, непонятен смысл вычислений вида «B3-B3».

[azbest]

Мне, правда, непонятен смысл вычислений вида «B3-B3».

Скорее всего ячейка B3- на разных листах,

[NoBrain]

Может быть, ввести формулу в ячейку при помощи кода VBA? »

И действительно - решение мне подходит.
Спасибо большое.

Мне, правда, непонятен смысл вычислений вида «B3-B3». »

Скорее всего ячейка B3- на разных листах, »

Я малость ступил. Мне нужно при таком раскладе "0" получить и я чего-то не сообразил написать просто "0", а решил операцию вычитая сам у себя.

[NoBrain]

Ребят, возможно наглею, но хотя бы кратко подскажите плз как организовать цикл, т.е.
Вот выполнилась операция (не просто 1+1, а начиная от вычисления формул, копирования и вставки в ячейки и до очистки всех не нужных ячеек), а теперь нужно сделать тоже самое еще раз и так столько раз пока значение в некоторой ячейке не будет меньше или равно, ну скажем 1000. Тогда этот цикл прекращается.

Попробовал первое что пришло в голову, но так не фурычит:

Код:

Dim sum As Integer
   sum = ActiveCell.FormulaLocal = "=B3"
   Do While sum >= 1000
   
'----------------------------
   Range("G3").Select
   ActiveCell.FormulaLocal = "=($I$2*C3)+B3"
   Selection.AutoFill Destination:=Range("G3:G26"), Type:=xlFillDefault
   Range("G3:G26").Select
   Selection.Copy
   Range("B3:B26").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
		:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("G3:G26").Select
   Selection.ClearContents
   Range("I3").Select
   ActiveCell.FormulaLocal = "=B2-(I2*1000)"
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
	   :=False, Transpose:=False
   Application.CutCopyMode = False
   Range("I3").Select
   Selection.ClearContents
	
   Range("G3").Select
   Range("G3").FormulaLocal = "=Если(E3="""";0;Если(B3>E3;B3-E3;0))"
   Selection.AutoFill Destination:=Range("G3:G26"), Type:=xlFillDefault
   Range("G3:G26").Select
   Range("I3").Select
   ActiveCell.FormulaLocal = "=СУММ(G3:G26)"
   Range("I4").Select
   ActiveCell.FormulaLocal = "=I3+B2"
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
		:=False, Transpose:=False
   Application.CutCopyMode = False
   
   Range("L3").Select
   ActiveCell.FormulaLocal = "=B3-G3"
   Selection.AutoFill Destination:=Range("L3:L26"), Type:=xlFillDefault
   Range("L3:L26").Select
   Selection.Copy
   Range("B3:B26").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
		:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("I3:I4").Select
   Selection.ClearContents
   Range("G3:G26").Select
   Selection.ClearContents
   Range("L3:L26").Select
   Selection.ClearContents
   Range("A1").Select
'----------------------------
   Loop

По-сути мне нужно что бы выполнялись операции между
Do While sum >= 1000 и до loop
Выполнялись пока сумма в одной ячейке не достигнет значения менее 1000

[Iska]

…а решил операцию вычитая сам у себя. »

Вы, случаем, лет тридцать назад с ассемблером не работали? Или, может, родитель там какой, а? И, так сказать, проснулась родовая память, и…

но хотя бы кратко подскажите плз как организовать цикл, т.е. »

Желательно было бы выложить образец самого файла, над которым проделываются сии манипуляции.

[NoBrain]

Желательно было бы выложить образец самого файла, над которым проделываются сии манипуляции. »

Ок.
Только там тип файла *.xlsm
Структуру файла оставил, названия некоторые изменил.

Смысл задачи такой.
Есть статьи расходов, для которых определена ставка с 1000 р. т.е. это минимальная единица распределения - сколько с этой суммы будет уходить в каждую статью.
Для некоторых статей есть лимит, т.е. если сумма превысила его, то излишек уходит т.с. в "общий котел".
И если сумма в этом "общем котле" опять превысит 1000, например 1230, то 1000 опять раскидывается по статьям, а 230 остаются не тронутыми, соответственно, если 8325 то раскидывается 1000*8 (т.е. операция 8 раз выполняется), 325 нетронутыми.

Один раз вся вот эта транзакция выполняется успешно, но если нужно 8 раз выполнить, то придется вручную тыкать кнопку 8 раз. А хотелось бы, что бы программа делала это сама до момента пока сумма в ячейке "общий котел" - "B2" не будет меньше 1000.

При этом самый первый модуль в цикл не входит.

Вот.

[NoBrain]

Вы, случаем, лет тридцать назад с ассемблером не работали? Или, может, родитель там какой, а? И, так сказать, проснулась родовая память, и… »

Не, не было.

[NoBrain]

Вопрос решен:

Код:

While Cells(2, 2) >= 1000
Code
Wend

[Iska]

Вопрос решен: »

Это хорошо, ибо я не очень понял, что именно Вам нужно помещать в цикл.

Но у меня для Вас всё же кое-что есть. Я сделал некоторые упрощения в приведённом Вами коде из выложенного файла:

Код:

Sub CopyValues()
'
' CopyValues Макрос
'
'   Копируем значение ключевого столбца в резерв
    Range("B3:B26").Select
    Selection.Copy
    Range("K3:K26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'  Выбираем ячейку в которой будем производить вычисления
   Range("G3").Select
'  Производим вычисления
   ActiveCell.FormulaLocal = "=($I$2*C3)+B3"
'  Растягиваем ячейку по вертикали
   Selection.AutoFill Destination:=Range("G3:G26"), Type:=xlFillDefault
   Range("G3:G26").Select
'  Копируем диапазон
   Selection.Copy
'  Выбираем диапазон, куда будем вставлять
   Range("B3:B26").Select
'  Вставляем значения
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
' Очищаем промежуточный стобец
   Range("G3:G26").Select
   Selection.ClearContents

'  Для того что бы убрать значение ячейки "B2"
'  производим вычисления в буферной ячеке и копируем значение из неё в нужную ячеку
   Range("I3").Select
   ActiveCell.FormulaLocal = "=B2-(I2*1000)"
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Application.CutCopyMode = False
   Range("I3").Select
   Selection.ClearContents
    
'  Операция учёта излишек
   Range("G3").Select
   Range("G3").FormulaLocal = "=Если(E3="""";0;Если(B3>E3;B3-E3;0))"
   Selection.AutoFill Destination:=Range("G3:G26"), Type:=xlFillDefault
   Range("G3:G26").Select
   Range("I3").Select
   ActiveCell.FormulaLocal = "=СУММ(G3:G26)"
   Range("I4").Select
   ActiveCell.FormulaLocal = "=I3+B2"
   Selection.Copy
   Range("B2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
   
   Range("L3").Select
   ActiveCell.FormulaLocal = "=B3-G3"
   Selection.AutoFill Destination:=Range("L3:L26"), Type:=xlFillDefault
   Range("L3:L26").Select
   Selection.Copy
   Range("B3:B26").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
   Range("I3:I4").Select
   Selection.ClearContents
   Range("G3:G26").Select
   Selection.ClearContents
   Range("L3:L26").Select
   Selection.ClearContents
   Range("A1").Select
   
      
   End Sub

и получил следующее (самого алгоритма вычислений я не касался):

Код:

'
' CopyValues Макрос
'
Sub CopyValues()
    Range("K3:K26").Value = Range("B3:B26").Value
    
    Range("G3:G26").FormulaLocal = "=($I$2*C3)+B3"
    Range("B3:B26").Value = Range("G3:G26").Value
    Range("G3:G26").ClearContents
    
    Range("B2").Value = Range("B2").Value - Range("I2").Value * 1000
    
    Range("G3:G26").FormulaLocal = "=Если(E3="""";0;Если(B3>E3;B3-E3;0))"
    Range("I3").FormulaLocal = "=СУММ(G3:G26)"
    Range("I4").FormulaLocal = "=I3+B2"
    Range("B2").Value = Range("I4").Value
    
    Range("L3:L26").FormulaLocal = "=B3-G3"
    Range("B3:B26").Value = Range("L3:L26").Value
    
    Range("I3:I4,G3:G26,L3:L26").ClearContents
End Sub

Общие принципы:

* операции с выделением:

Код:

Range("…").Select
Selection.…

заменены на прямую работу с диапазонами:

Код:

Range("…").…

* операции по ручному копированию-вставке:

Код:

Selection.Copy
Range("…").Select
Selection.PasteSpecial …

заменены прямым присваиванием:

Код:

Range("…").Value = Range("…").Value

* операции по вставке формулы в ячейку и последующее распространение этой формулы на диапазон ячеек:

Код:

Range("…").Select
ActiveCell.FormulaLocal = "=…"
Selection.AutoFill Destination:=Range("…"), Type:=xlFillDefault

заменено на одно присваивание формулы всему потребному диапазону ячеек:

Код:

Range("…").FormulaLocal = "=…"

* очистку можно производить над объединением диапазонов:

Код:

Range("…, …, …").ClearContents

Пробуйте.