Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.11.2017, 23:22   #1
FINt09
Пользователь
 
Регистрация: 24.11.2017
Сообщений: 20
По умолчанию Oтслеживание диапазона чисел и присвоение ранга при изменении.

Здравствуйте ! Обращаюсь к Вам за помощью, т.к. самостоятельное решение и поиски не увенчались успехом. В файле-примере имеется простая таблица с наименование Товар( столбец А) и Приоритетом их покупки (столбец В) .Приоритеты выставляются в ручную и также в ручную могут изменяться. Либо какой то номер может быть удален полностью и все приоритеты должны меняться по рангу (например на Листе2: удаляем 1й приоритет и следующие за ним числа меняют ранг, 2й становится первым, 3й - вторым и т.д.), либо приоритеты меняются местами, пример Лист3: поставив в ячейку B11 приоритет 2 в этой ячейке становится 2, а в ячейке В7 становиться приоритет 3, который был в ячейке B11. Помогите пожалуйста с макросом, отслеживающим диапазон и присваивающий ранг при изменении чисел!
Вложения
Тип файла: xlsx Пример.xlsx (11.2 Кб, 13 просмотров)
FINt09 вне форума Ответить с цитированием
Старый 26.11.2017, 12:25   #2
FINt09
Пользователь
 
Регистрация: 24.11.2017
Сообщений: 20
По умолчанию

Этот макрос постарался видоизменить под себя, но видно не правильно что то вписал. Может кто знающий глянет макрос для моего Примера?:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i&, j&, Test As Range, Uslovie As Boolean
    Set Test = Range("B2:B12")
    Const Nrow& = 11 'кол-во строк в запоминаемом и тестируемом диапазоне
    Const Ncol& = 1 'кол-во столбцов
    Static Oldvalue(Nrow, Ncol) As Variant
    For i = 1 To Nrow
        For j = 1 To Ncol
            With Test.Cells(i, j)
                If .Value <> Oldvalue(i, j) Then
                    Uslovie = True
                    Oldvalue(i, j) = .Value
                End If
            End With
        Next j
    Next i
    If Uslovie Then ' Ранжирование измененного диапазона
End Sub
FINt09 вне форума Ответить с цитированием
Старый 26.11.2017, 12:42   #3
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
If Uslovie Then ' Ранжирование измененного диапазона
а где, собственно, реализация ранжирования?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 26.11.2017, 12:54   #4
FINt09
Пользователь
 
Регистрация: 24.11.2017
Сообщений: 20
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Код:
If Uslovie Then ' Ранжирование измененного диапазона
а где, собственно, реализация ранжирования?
Я не особо силен в написании кода). Может быть:
ActiveCell.Formula = "=RANG(B2;$B$2:$B$12;1))"?
FINt09 вне форума Ответить с цитированием
Старый 26.11.2017, 16:13   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от FINt09 Посмотреть сообщение
Может быть:
ActiveCell.Formula = "=RANG(B2;$B$2:$B$12;1))"?
а как же?
Цитата:
Сообщение от FINt09 Посмотреть сообщение
Приоритеты выставляются в ручную и также в ручную могут изменяться.
Код для Лист1. подпилите под себя
Код:
Option Explicit
Dim zapas

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range
    On Error GoTo erl
    If Intersect(ActiveCell, Range("B2:B12")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Target = "" And CInt(zapas) > 0 Then
       For Each cl In Range("B2:B12")
           If cl >= zapas Then cl = cl - 1
       Next cl
       Exit Sub
    End If
    If Target <> "" And CInt(zapas) > 0 Then
       For Each cl In Range("B2:B12")
           If cl = Target And Target.Address <> cl.Address Then cl = zapas
       Next cl
       Exit Sub
    End If
    If Target <> "" And CInt(zapas) = 0 Then
       For Each cl In Range("B2:B12")
           If cl > Target And Target.Address <> cl.Address Then cl = cl + 1
       Next cl
       Exit Sub
    End If
erl:
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(ActiveCell, Range("B2:B12")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    zapas = Target.Value
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 26.11.2017, 20:05   #6
Oldy7
Пользователь
 
Регистрация: 25.02.2012
Сообщений: 28
По умолчанию

Во вложении два варианта макроса - с сортировкой по приоритетам и без.
Т.к. это пример и прочее, то обработанный макросом массив с изменениями выгружается в G2.

Формулы в столбце С показывают ничего ли макрос не пропустил.

Чтобы макрос запускался при наличии изменений в столбце В, то вот:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
If Not Me.ProtectContents Then
    Call CheckPriority0
End If
End Sub
Это в модуль листа (ПКМ на ярлыке листа/исходный текст)
Пример.xls
Oldy7 вне форума Ответить с цитированием
Старый 26.11.2017, 20:32   #7
FINt09
Пользователь
 
Регистрация: 24.11.2017
Сообщений: 20
По умолчанию

Спасибо огромное всем кто откликнулся, завтра на работе потестирую!!!)
FINt09 вне форума Ответить с цитированием
Старый 27.11.2017, 00:10   #8
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Цитата:
а где, собственно, реализация ранжирования?
Aleksandr H.,
нет там никакого ранжирования
просто автор решил так назвать то, что у него там должно происходить с данными.
есть диапазон размером Х ячеек, заполненный значениями от 1 до Х
как только пользователь изменил одно из значений - должны произойти изменения с другим(и) значением(ями) в рассматриваемом диапазоне.

к ранжированию это имеет такое же отношение, как я к прыжкам с трамплина.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 27.11.2017, 11:00   #9
FINt09
Пользователь
 
Регистрация: 24.11.2017
Сообщений: 20
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Код для Лист1. подпилите под себя
Добрый день! Не получается подделать Ваш код под свой файл- оригинал, помогите пожалуйста.
Вложения
Тип файла: xlsx Пример (2).xlsx (36.8 Кб, 14 просмотров)
FINt09 вне форума Ответить с цитированием
Старый 27.11.2017, 11:06   #10
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

доделать не можете?
а обьяснить можете? что там должно происходить с данными:
1. было так
2. пльзователь сделал так
3. нужно получить это
у Вас там были примеры, добавьте пару и не нужно будет доделать, там где Вы не пониманиете как доделать. Потому что Александ, видимо, думает над тем, как ранжировать то, что в ранжировании не нуждается.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Расчет диапазона чисел lanzar Microsoft Office Excel 0 20.04.2015 17:08
Включение макроса при изменении текста. gling Microsoft Office Excel 3 20.07.2010 20:11
Событие при изменении дерева RIO Общие вопросы Delphi 17 17.05.2010 02:35
innerHTML при изменении st1512 HTML и CSS 0 07.09.2009 10:04
Работа программы при изменении Rom1k06 Microsoft Office Excel 8 18.01.2009 19:05