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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 27.01.2010, 12:34   #1
dzv
Пользователь
 
Аватар для dzv
 
Регистрация: 15.01.2010
Сообщений: 55
Восклицание Сортировка списка при добавление новых значений

Здравствуйте, уважаемые Участники клуба!

Прошу помочь исправить ошибку в приведенном ниже макросе, он состоит из двух:
1. Добавление в список нового значения.
2. Сортировка списка.

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$AC$7" Then
     If IsEmpty(Target) Then Exit Sub
       If WorksheetFunction.CountIf(Sheets("Формули").Range("Замовник"), Target) = 0 Then
          lReply = MsgBox("Додати Замовника: * " & _
                        Target & " * у випадний список?", vbYesNo + vbQuestion)
          If lReply = vbYes Then
              Sheets("Формули").Range("Замовник").Cells(Sheets("Формули").Range("Замовник").Rows.Count + 1, 1) = Target
          End If
       End If
     End If
ActiveWorkbook.Worksheets("Формули").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Формули").Sort.SortFields.Add Key:=Range("Замовник"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Формули").Sort
.SetRange Range("Замовник")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Макрос работает до "ActiveWorkbook.Worksheets("Формули" ).Sort.SortFields.Clear", тоесть добавляет значения в список. Но после этого момента и дальше, работать отказывается, тобишь сортировать.

Жду Ваши предложения и благодарю за помощь и время!

Последний раз редактировалось dzv; 27.01.2010 в 12:38.
dzv вне форума Ответить с цитированием
Старый 27.01.2010, 12:56   #2
Maxx
Форумчанин
 
Аватар для Maxx
 
Регистрация: 29.10.2008
Сообщений: 294
По умолчанию

Может так:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$AC$7" Then
     If IsEmpty(Target) Then Exit Sub
       If WorksheetFunction.CountIf(Sheets("Формули").Range("Замовник"), Target) = 0 Then
          lReply = MsgBox("Додати Замовника: * " & _
                        Target & " * у випадний список?", vbYesNo + vbQuestion)
          If lReply = vbYes Then
              Sheets("Формули").Range("Замовник").Cells(Sheets("Формули").Range("Замовник").Rows.Count + 1, 1) = Target
          End If
       End If
     End If
Selection.AutoFilter
ActiveWorkbook.Worksheets("Формули").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Формули").AutoFilter.Sort.SortFields.Add Key:=Range("Замовник"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Формули").AutoFilter.Sort
.SetRange Range("Замовник")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
End Sub
только перед выполнением фильтры должны быть сняты.

И не пойму зачем вот это .SetRange Range("Замовник"). Уберите.

Последний раз редактировалось Maxx; 27.01.2010 в 13:31.
Maxx вне форума Ответить с цитированием
Старый 27.01.2010, 14:05   #3
dzv
Пользователь
 
Аватар для dzv
 
Регистрация: 15.01.2010
Сообщений: 55
По умолчанию

Maxx, спасибо, но не помогло.

Давайте я уточню.

Макрос находится в "Лист1", список "Замовник" в "Лист2" .
"Лист2" это "Формули".

Да, фильтр у меня не стоит, грубо говоря, в столбце А идет нумерация с А1 по А10: 1,2,3,..,10.

Последний раз редактировалось dzv; 27.01.2010 в 14:09.
dzv вне форума Ответить с цитированием
Старый 27.01.2010, 14:09   #4
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

Может так?

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address <> "$AC$7" Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    With Sheets("Формули").Range("Замовник")
        If WorksheetFunction.CountIf(.Cells, Target) = 0 Then
            If MsgBox("Додати Замовника: * " & Target & " * у випадний список?", _
                      vbYesNo + vbQuestion) = vbYes Then _
               .Cells(.Row + .Rows.Count, 1) = Target
        End If
        .Sort .Cells(1), xlAscending
    End With
End Sub
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru

Последний раз редактировалось The_Prist; 27.01.2010 в 14:14.
The_Prist вне форума Ответить с цитированием
Старый 27.01.2010, 16:17   #5
dzv
Пользователь
 
Аватар для dzv
 
Регистрация: 15.01.2010
Сообщений: 55
Хорошо Спасибо!

The_Prist, супер, спасибо Вам!

Последнее, а если я вот так подправлю, это правильно будет (работает, но хотелось бы услышать Ваше мнение):

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address <> "$AD$7" Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
        With Sheets("Формули").Range("Замовник")
        If WorksheetFunction.CountIf(.Cells, Target) = 0 Then
            If MsgBox("Додати Замовника: * " & Target & " * у список?", _
                      vbYesNo + vbQuestion) = vbYes Then _
               .Cells(.Row + .Rows.Count, 1) = Target
        End If
        End With
    With Sheets("Формули").Range("Замовник")
        .Sort .Cells(1), xlAscending
    End With
End Sub
dzv вне форума Ответить с цитированием
Старый 27.01.2010, 16:46   #6
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

А зачем так? Ведь Вы просто дублируете конструкцию With ... End With. Это лишние строки кода. Я и сделал так именно потому, что работаете в коде Вы только с одним диапазоном. Принципиально Вы ничего не поменяли, просто задублировали пару строк, что привело к раздуванию кода без улучшения функциональности. Короче, лишнее это.
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума Ответить с цитированием
Старый 27.01.2010, 17:07   #7
dzv
Пользователь
 
Аватар для dzv
 
Регистрация: 15.01.2010
Сообщений: 55
По умолчанию

Цитата:
Сообщение от The_Prist Посмотреть сообщение
Короче, лишнее это.
Подождите немного

В вашем варианте, список сортируется при в воде нового значения, но при этом, само новое значение добавляется снизу, оно сортируется при вводе другого нового значения и т.д. Поэтому я добавил снизу, возможно дубляж, что позволило сортировать данные в списке, после ввода нового значения. Вот

Возможно, что-то лишнее, я не спорю, потому что с Бейсиком не дружу, только учусь.
dzv вне форума Ответить с цитированием
Старый 27.01.2010, 17:16   #8
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

Цитата:
Сообщение от dzv Посмотреть сообщение
В вашем варианте, список сортируется при в воде нового значения, но при этом, само новое значение добавляется снизу
Возможно VBA не сразу обновляет данные о изменившейся размерности диапазона в конструкции With ... End With и поэтому Вы перепрописывая её как бы и переназначаете и обновляете данные о размерности диапазона.
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума Ответить с цитированием
Старый 27.01.2010, 17:30   #9
dzv
Пользователь
 
Аватар для dzv
 
Регистрация: 15.01.2010
Сообщений: 55
По умолчанию

Цитата:
Сообщение от The_Prist Посмотреть сообщение
Возможно VBA не сразу обновляет данные о изменившейся размерности диапазона в конструкции With ... End With и поэтому Вы перепрописывая её как бы и переназначаете и обновляете данные о размерности диапазона.
Еще раз попробовал Ваш вариант, отказывается сортировать с учетом нового значения "х", но когда я ввожу другое новое значение "у" и нажимаю кнопку "нет", сортировка работает и сортирует "х".

Забыл, у меня MO 2003.

Последний раз редактировалось dzv; 27.01.2010 в 17:34.
dzv вне форума Ответить с цитированием
Старый 27.01.2010, 18:16   #10
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

Цитата:
Сообщение от dzv Посмотреть сообщение
Еще раз попробовал Ваш вариант, отказывается сортировать с учетом нового значения "х", но когда я ввожу другое новое значение "у" и нажимаю кнопку "нет", сортировка работает и сортирует "х".
Я это понял и написал причину. Я код не тестировал на данных. Я просто подправил Ваш.
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Изменение значений одного выпадающего списка, при измнении значения другого Ground Microsoft Office Access 5 07.09.2010 22:00
Каскадное обновление взаимосвязанных полей со списком и добавление новых значений AlEx_IB Microsoft Office Access 12 11.09.2009 16:55
Добавление новых правил для пользователей форума.. Mr.Qwerty О форуме и сайтах клуба 17 04.09.2009 00:04
Qt. QSqlTableModel. Добавление новых строк. HIC Qt и кроссплатформенное программирование С/С++ 0 07.07.2009 16:31
Добавление списка в меню ГОСЕАН БД в Delphi 5 15.07.2007 13:34