Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.92/92: Рейтинг темы: голосов - 92, средняя оценка - 4.92
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
1

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

22.03.2013, 21:02. Просмотров 16751. Ответов 16
Метки нет (Все метки)

Добрый день! Никак не могу сделать следующее:
Есть 3 ячейки. При вводе значения в ячейку 1, ячейки 2 и 3 пересчитываются по формуле, которая использует значение ячейки 1. При вводе значения в ячейку 2 происходит тоже самое, только с ячейками 1 и 3, т.е. Ячейки 1 и 3 пересчитываются по формулам, которые используют значение ячейки 2. Ну и при вводе в ячейку номер 3 аналогично.
Задача состоит в том, чтобы используя метод intersect добиться чтобы при изменении одной из ячеек, остальные пересчитывались автоматически.
Vba Excel 2010
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
22.03.2013, 21:02
Ответы с готовыми решениями:

Как добиться, чтобы при изменении шапки на одной веб-странице шапка на всех веб-страницах менялась автоматически?
Подскажите, пожалуйста, как добиться, чтобы, если я что-то меняю в шапке сайта на одной...

Нужно, чтобы при выборе техники остальные поля заполнились автоматически
Нужна помощь. При списании техники на склад техника выбирается из LookUpComboBox. Нужно чтобы при...

не могу сделать так, чтобы при изменении пункта в договоре ссылки на него в дальнейшем тексте автоматически менялись
Добрый день! Помогите пожалуйста, если кто может, решить задачку: есть документ Word (договор) -...

Таблицей стилей добиться, чтобы оформление рисунка добавлялось автоматически
Здравствуйте. Есть задание:Используя текстовый фрагмент с несколькими изображениями, разместить...

16
4375 / 659 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
23.03.2013, 14:00 2
Здравствуйте. Как-то не понятно. А зачем Intersect? Почему не использовать, например, модуль листа и Change? Intersect, в классике, даст Вам диапазон, состоящий из набора ячеек, входящих в общую область (пересечение) двух диапазонов (rng1 и rng2), в том числе когда они не смежные.

Добавлено через 16 минут
Вот, как демонстрация:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Demo_mIntsectRange()
    ' ВСЕ SELECT ТОЛЬКО КАК ДЕМО!!!
   Dim mRng As Range, r1 As Range, r2 As Range
    Set r1 = Union(Columns(3), Columns(5), Columns(6), Columns(8))
    r1.Select ' !!!
    Set r2 = Union(Rows(3), Rows(4), Rows(5), Rows(7))
    r2.Select ' !!!
    Union(r1, r2).Select ' !!!
    Cells(1, 1).Select
    Set mRng = Intersect(r1, r2)
    mRng.Interior.ColorIndex = 36
    Union(r1, r2).Select ' !!!
End Sub
Или я что-то не так понимаю?
0
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
23.03.2013, 14:08  [ТС] 3
В этом месте пожалуйста по подробнее, и желательно с примером.
На самом деле таких вот блоков (из 3 ячеек) у меня несколько - порядка 15. И при изменении ячейки, как описано ранее, остальные измемнения должны проискодить в пределах текущего блока.
0
4375 / 659 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
23.03.2013, 14:19 4
В этом месте пожалуйста по подробнее, и желательно с примером
Вы и так загадочный, а теперь вобще интрига возросла
Если Вам нужно что б, например, при изменении значения в ячейке происходили на листе какие-либо изменения, нужно прописать (как вариант) в модуле этого листа!!! определенную процедуру. К нему можно добраться правой кнопкой на ярлыке, левой выбрать "Исходный текст". А примеров - на форуме их куча. Выложите здесь свой, можно будет корректировать.
0
14942 / 6341 / 1724
Регистрация: 24.09.2011
Сообщений: 9,976
23.03.2013, 14:38 5
Пробуйте. Описание в файле.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n&, change, r As Range, c As Range
Set r = Range("A1:A3")
Set Target = Intersect(Target, r)   '<<< Intersect
If Target Is Nothing Then Exit Sub
Application.EnableEvents = False
n = r.Count - Target.Count 'число ячеек, меняемых программно
If n = 0 Then
    Application.Undo
    MsgBox "Менять нечего!"
Else
    change = ([C1] - Application.Sum(r)) / n
    For Each c In r
        If Intersect(c, Target) Is Nothing Then '<<< Intersect
            c = Application.Sum(c, change)
        End If
    Next
End If
Application.EnableEvents = True
End Sub
1
Вложения
Тип файла: xls Intersect.xls (21.0 Кб, 54 просмотров)
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
23.03.2013, 16:11  [ТС] 6
Спасибо за примеры, но это не совсем то что надо. Во вложении я попытался более наглядно описать то что необходимо сделать
0
Вложения
Тип файла: xls Example.xls (59.0 Кб, 29 просмотров)
14942 / 6341 / 1724
Регистрация: 24.09.2011
Сообщений: 9,976
23.03.2013, 16:41 7
А сразу нельзя было файл приложить?
Теперь разъясните подробно, что должно происходить при изменении ячеек, на примере Block 6.
0
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
23.03.2013, 19:26  [ТС] 8
В блоке 6 - 4 величины a, b, c и d. Формулы для расчёта каждой величины есть в примере. Идея в том, что, например введя величину a, ячейки b, c и d рассчитывают исходя из значения a. Если ввести значение b, то весь расчет идет отталкиваясь от значения b и т.д.
Ну вот например: есть у нас масса, объем и процентные наполнение емкости. Если вводим массу(a), то объем расчитывается, как масса деленная на плотность(x); процентное наполнение, как объем *100/общий обьем(y);
Если вводим обьем(b), то масса расчитывается как объем(b) умноженный на плотность(x) и т.д.
Тот же принцип если вводим процентное наполнение емкости.
Необходимо чтобы в каждом блоке все это считалось независимо от других блоков, и чтобы каждому блоку соответствовал свой x и свой y; т.е. Если на примере емкости - у каждой емкости свой максимальный обьем(y) и плотность жидкости находящейся в нем(x).
Прошу прощения что сразу не объяснил нормально...
Спасибо!
0
1559 / 637 / 220
Регистрация: 09.06.2011
Сообщений: 1,308
23.03.2013, 23:12 9
Лучший ответ Сообщение было отмечено как решение

Решение

Доброго, если правильно понял ...
0
Вложения
Тип файла: xls Example.xls (73.5 Кб, 85 просмотров)
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
24.03.2013, 01:59  [ТС] 10
Спасибо большое! Все работает
Если можно еще пару вопросов:
1.как в данном примере (Смотри вложение), сделать следующее: при вводе в нижнюю таблицу, наименования Name 1, Name 2 и т.д. столбцы в таблице окрашивались бы в разные цвета. В свою очередь, при вводе названия в Блоки, данный блок так же окрашивался бы цветом соответствующим данному наименованию в нижней таблице.
2.при удалении наименования из нижней таблицы, столбец теряет цвет, т.е. становится либо безцветным, либо белым; в свою очередь блоки в которых находится данное наименование окрашиваются в белый цвет, или также становятся везцветными
3.в нижей таблице, в строке Total, по каждому наименованию, в зависимости от количества в блоках, расчитывается общее количество данного наименования, т.е. если в блоке 12 и блоке 1 наименование Name 1, то в нижней таблице будет общее количество т.е. 100+300=400
0
Вложения
Тип файла: xls Example.xls (58.5 Кб, 12 просмотров)
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
24.03.2013, 12:38  [ТС] 11
Добрый день!
Стыдно признаться, но никак немогу разобраться - нужно вставить 10 столбцов справа и 10 строк сверху. Что нужно поменять в коде, чтобы после вставки все работало?
0
4375 / 659 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
24.03.2013, 15:17 12
Ничего стыдного не вижу.
Авторы молчат, может тогда я.
Вот здесь, в коде Step_UA:
If Target.Count = 1 And Not (Intersect(Target, [a6:f9,a12:f15]) Is Nothing) Then
Диапазон [a6:f9,a12:f15] задан явно. Нужно заменить процедурой определения нужного диапазона в обычном модуле через новую переменную, например, МойНужныйДиапазон As Range (но обявить эту переменную как Public), и из кода Step_UA вызвать эту "обычную процедуру". Тогда в коде "... _Change.." выражение, которое выше, будет выглядеть так:
If Target.Count = 1 And Not (Intersect(Target, МойНужныйДиапазон) Is Nothing) Then
Должно сработать. И тогда вставляйте сверху/снизу, слева/справа как хотите и сколько хотите.

Добавлено через 5 минут
Святая Мария!
И тогда вставляйте сверху/снизу, слева/справа как хотите и сколько хотите.
Я имел в виду строки и столбцы.

Добавлено через 48 минут
Вот, что-то так.
В обычном модуле:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
Public wrkRange As Range ' видимость везде!
Sub myWrkRanges()
Dim mRng As Range, tmpRng As Range
Dim mArr(), endRow&, endCol&, i&
 
    mArr = Array("Block 1", "Block 7")
        With ActiveSheet
            endRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
            endCol = .UsedRange.Column - 1 + .UsedRange.Columns.Count
            Set mRng = Range(.Cells(1, 1), .Cells(endRow, endCol))
            For i = LBound(mArr) To UBound(mArr)
                Set tmpRng = mRng.Find(What:=mArr(i), _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByColumns, _
                                SearchFormat:=False)
                Set tmpRng = Range(tmpRng.Offset(2, 0), _
                                            tmpRng.Offset(5, 5))
                If i = LBound(mArr) Then
                    Set wrkRange = tmpRng
                        Else
                            Set wrkRange = Union(wrkRange, tmpRng)
                End If
            Next 'i
    End With
End Sub
А в модуле листа тогда начало нужно изменить так:
Visual Basic
1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
    Call myWrkRanges
    If Target.Count = 1 And Not (Intersect(Target, wrkRange) Is Nothing) Then
Но если честно, в тех редких случаях, когда все-таки использую модуль листа, тогда, по сравнению с данным, ставлю с ног на голову. При изменении - вызываються обычные процедуры:
Visual Basic
1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
   Call 'proced 1'
   Call 'proced 2'
   Call 'proced 3'
  .......................
end sub
Пробуйте. Удачи.
1
1559 / 637 / 220
Регистрация: 09.06.2011
Сообщений: 1,308
24.03.2013, 15:22 13
Дополню коментарий Igor_Tr, необходимо также скорректировать вычисление Block (номер блока), BaseRow (номер первой строки соответствующего блока - значение а), а также
Visual Basic
1
Select Case .Row mod 6  => Select Case .Row - BaseRow
0
1559 / 637 / 220
Регистрация: 09.06.2011
Сообщений: 1,308
24.03.2013, 16:06 14
Чтоб производить поиск по ключевому слову необходимо быть увереным, что оно единственное или расположено первым ... предпочитаю работать с именованными диапазонами
1
Вложения
Тип файла: xls Example.xls (76.0 Кб, 19 просмотров)
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
24.03.2013, 23:42  [ТС] 15
Всем большое спасибо за участие! Самому было бы довольно трудно дойти пока делаю первые шаги в данном направлении.
Опробовал оба варианта, оба понравились. Буду разбираться.

Пытаюсь сделать то что описывал в предыдущем вопросе:

1.в данном примере (Смотри вложение): при вводе в нижнюю таблицу, наименования Name 1, Name 2 и т.д. столбцы в таблице окрашивались бы в разные цвета. В свою очередь, при вводе названия в Блоки, данный блок так же окрашивался бы цветом соответствующим данному наименованию в нижней таблице.
2.при удалении наименования из нижней таблицы, столбец теряет цвет, т.е. становится либо безцветным, либо белым; в свою очередь блоки в которых находится данное наименование окрашиваются в белый цвет, или также становятся везцветными
3.в нижей таблице, в строке Total, по каждому наименованию, в зависимости от количества в блоках, расчитывается общее количество данного наименования, т.е. если в блоке 12 и блоке 7 и 5 наименование Name 1, то в нижней таблице будет общее количество т.е. 70+50+120=240

Но как-то все не выходит. Вернее выходит, но оооочень коряво - знаний не хватает. Буду оооочень признателен за советы и помощь
0
Вложения
Тип файла: xls Example1.xls (60.5 Кб, 14 просмотров)
0 / 0 / 0
Регистрация: 24.01.2013
Сообщений: 16
25.03.2013, 20:49  [ТС] 16
Ау, товарищи!
Приветствуются любые подсказки.
0
1559 / 637 / 220
Регистрация: 09.06.2011
Сообщений: 1,308
25.03.2013, 21:26 17
Цитата Сообщение от justas150776 Посмотреть сообщение
Ау, товарищи!
Приветствуются любые подсказки.
по теме вы получили ответ, не по теме п.4.4 правил

Не по теме:

поиск решения задачи не связанной с темой действительно затруднен ...

1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
25.03.2013, 21:26

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

Как сделать так чтобы при изменении одной переменной изменялась другая?
Как сделать так чтобы при изменении одной переменной изменялась другая?

Как сделать так, чтобы при выделении одной ячейки не выделялись остальные в строке DataGrid?
т.е. как сделать, чтобы когда я нажимаю, например, на &quot;Узел 1:1&quot;, &quot;Узел 0:1&quot; оставался белым?


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
17
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.