Сохранение и удаление значений и ввод формул по условию

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Сохранение и удаление значений и ввод формул по условию (Макросы/Sub)

_Shurik_

Дата: Четверг, 16.11.2017, 11:33 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день!
Есть некая таблица. В колонке "A" встречается цифра "1". В колонке "B" введены формулы - какое-то значение (переменное) плюс значение соседней ячейки "C".
Нужны 2 макроса на выполнение следующего условия:
1. Если в колонке "A" встречается цифра 1, необходимо по данной строке полученную сумму в колонке "B" сохранить как значение, а данные в колонке "C" удалить. Если в колонке "A" ничего нет, соответственно по данной строке выполнять ничего не надо.
2. При том-же самом условии, после выполнения 1-го макроса, необходимо ввести формулу: к полученному значению в колонке "B" прибавить соседнюю ячейку "C"

Макросы нужны по отдельности, при необходимости сам объеденю. Буду очень благодарен за помощь.

К сообщению приложен файл: 5429173.xlsx (13.4 Kb)

Ответить

sboy

Дата: Четверг, 16.11.2017, 11:52 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Добрый день.
два в одном сразу
[vba]

Код

Sub Скругленныйпрямоугольник2_Щелчок()
    Set r = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
        For Each cl In r.Cells
            If cl.Offset(0, -1) = 1 Then
                cl.Value = cl.Value
                cl.Formula = "=" & cl.Value & "+" & cl.Offset(0, 1).Address
                cl.Offset(0, 1).Clearcontents
            End If
        Next
End Sub

[/vba]

К сообщению приложен файл: 5429173.xlsm (19.0 Kb)

Яндекс: 410016850021169

Сообщение отредактировал sboy - Четверг, 16.11.2017, 12:34

Ответить

_Boroda_

Дата: Четверг, 16.11.2017, 12:04 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Без цикла по каждой ячейке, все сразу сначала забираем, потом вставляем
[vba]

Код

Sub tt1()
    r0_ = 1
    r1_ = Range("B" & Rows.Count).End(3).Row
    n_ = r1_ - r0_ + 1
    arf = Range("A" & r0_).Resize(n_, 3).Formula
    arz = Range("A" & r0_).Resize(n_, 3)
    For i = 1 To n_
        If arz(i, 1) = 1 Then
            arf(i, 2) = arz(i, 2)
            arf(i, 3) = ""
        End If
    Next i
    Range("A" & r0_).Resize(n_, 3).Formula = arf
End Sub

Sub tt2()
    r0_ = 1
    r1_ = Range("B" & Rows.Count).End(3).Row
    n_ = r1_ - r0_ + 1
    ar = Range("A" & r0_).Resize(n_, 3)
    For i = 1 To n_
        If ar(i, 1) = 1 Then
            ar(i, 2) = "=" & ar(i, 2) & "+RC[1]"
        End If
    Next i
    Range("A" & r0_).Resize(n_, 3).Formula = ar
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

_Shurik_

Дата: Четверг, 16.11.2017, 12:26 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Sboy, не выполняется условие для колонки "C" - удаляются все данные, надо только по тем строчкам, где находятся единицы.
Boroda, Ваш вариант мне больше нравится, но 2-й макрос также не учитывает условие - там, где отсутствует единица, данные сохраняются как значения, а надо их не затрагивать. 1-й макрос - то, что нужно.

Ответить

_Boroda_

Дата: Четверг, 16.11.2017, 12:31 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

А, ну да, забыл я про них. Вот так
[vba]

Код

Sub tt2()
    r0_ = 1
    r1_ = Range("B" & Rows.Count).End(3).Row
    n_ = r1_ - r0_ + 1
    arf = Range("A" & r0_).Resize(n_, 3).Formula
    arz = Range("A" & r0_).Resize(n_, 3)
    For i = 1 To n_
        If arz(i, 1) = 1 Then
            arf(i, 2) = "=" & arz(i, 2) & "+RC[1]"
        End If
    Next i
    Range("A" & r0_).Resize(n_, 3).Formula = arf
End Sub

[/vba]