СообЧа > База Знаний > Программы > MS Excel

Вопрос

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

Ответ

Если Вы это делаете вручную, то нужно всего лишь копировать через Специальную вставку (Значения), тогда ячейки не будут связаны впрямую с исходной ячейкой, и ее можно будет редактировать как угодно.
Если же нужно это делать (полу)автоматически, то примерно так (проверено в Excel 2000. Предполагается, что первичная ячейка к началу применения макроса выделена и вместе с ней не выделены никакие другие ячейки):

Sub Exp1()
On Error GoTo err1
Dim strCell As String, rng As Range, Var As Variant
Set rng = Application.Selection
'Вместо следующей строки можно вставить strCell=Range("A3"),
'если известно, что значение переносится в ячейку А3
strCell = InputBox("Введите адрес ячейки для переноса значения")
'На всякий случай копируем формат исходной ячейки
Selection.Copy
Range(strCell).Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Конец копирования формата
'Вставляем значение
Var = rng.Value
Range(strCell).Value = Var
'Вместо следующей строки можно вставить strCell=Range("A3"),
'если известно, что значение суммируется с ячейкой А3
strCell = InputBox("Введите адрес ячейки для суммирования")
'Прибавляем к ячейке
Range(strCell).Value = Var + Range(strCell).Value
'Обнуляем первую ячейку
rng.Value = 0
'Или вообще очищаем первую ячейку — тогда вместо нуля поставить ""

Exit Sub

'В случае ошибки в адресах ячейки просим повторить ввод
err1:
If Err.Number = 1004 Then
strCell = InputBox("Введите правильный адрес ячейки")
Resume
End If
End Sub


Alex



Copyright © 2000-2004 Сообщество Чайников
Контактная информация