Запрет выбора аналогичных значений в последовательном списк

Дата: Вторник, 29.04.2014, 17:36 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 17

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

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

Excel 2010

Доброго времени суток, уважаемые гуру!

Создавал аналогичную тему в вопросах по Excel, направили сюда.

Просьба помочь со следующими проблемами:
1. При выборе уровня профессионализма "Manual" или "Professional" в разделе "Level" открывается меню выбора компетенций "Professional Competencies". Подскажите верное решение, чтобы в трех строчках выбора нельзя было выбирать одинаковые компетенции (сообщение об ошибке, как в выборе из списка).

2. При выборе уровня профессионализма "Manual", "Professional" в разделе "Level" меню выбора компетенций "Professional Competencies" имеет длину в три строчки. А если выбирать уровень профессионализма "Manager", то меню выбора компетенций меняет свое название на "Managerial Competencies" и длина его увеличивается до 6 строк. При использовании защиты ячеек (незащищенными оставляю все ячейки кремового цвета, т.к. они заполняются или вручную, или данными из списков) меню выбора компетенций название своё меняет ("Professional Competencies" на "Managerial Competencies"), а вот кол-во строк не меняется с 3 на 6.

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

гыгыгы

Дата: Пятница, 02.05.2014, 03:50 | Сообщение № 2

Группа: Гости

[moder]

[/moder]

Дата: Пятница, 02.05.2014, 21:03 | Сообщение № 3

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

Ранг: Новичок

Сообщений: 17

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

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

Excel 2010

Та да))

Дата: Воскресенье, 04.05.2014, 04:42 | Сообщение № 4

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

Ранг: Старожил

Сообщений: 2347

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

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

Excel 2007,2010,2013

проблема №1 вариант с дополнительными столбцами

в ячейку M85 поставить два пробела
в диапазоне N76:N85 формула

Код

{=СТРОКА()-ЕСЛИ(ЕСЛИОШИБКА(ПОДСТАВИТЬ($M$76:$M$85;ИНДЕКС($E$39:$E$44;ПОИСКПОЗ($M$76:$M$85;$E$39:$E$44;0));"");$M$76:$M$85)<>"";75;65)}

в диапазоне O76:O85 формула

Код

{=ТЕКСТ(ИНДЕКС(ЕСЛИОШИБКА(ПОДСТАВИТЬ($M$76:$M$85;ИНДЕКС($E$39:$E$44;ПОИСКПОЗ($M$76:$M$85;$E$39:$E$44;0));"");$M$76:$M$85); ПОИСКПОЗ(НАИМЕНЬШИЙ(СЧЁТЕСЛИ($N$76:$N$85; "<"&$N$76:$N$85); СТРОКА($A:$A)); СЧЁТЕСЛИ($N$76:$N$85; "<"&$N$76:$N$85); 0));"")}

создать именованный диапазон с именем List и диапазоном

Код

=СМЕЩ($O$76:$O$86;0;0;еслиошибка(ПОИСКПОЗ(" ";$O$76:$O$86;0);ПОИСКПОЗ(" ";$O$76:$O$86;0));1)

в процедуре MannagerList заменить [vba]

Код

Formula1:="=$M$76:$M$85"

[/vba] на [vba]

Код

Formula1:="=List"

[/vba]

Проблема №2

в макросе перед строкой [vba]

Код

A1 = "Organization and planning"

[/vba]
добавить строку [vba]

Код

ActiveSheet.Unprotect

[/vba]
и после строки [vba]

Код

Range("C6").Select

[/vba]
добавить строку [vba]

Код

ActiveSheet.Protect

[/vba]

ЗЫ

в процедуре Workbook_SheetChange я бы посоветовал заменить [vba]

Код

Select Case CStr(target)
          Case "_": MannagerList (-1)
          Case "Manager": MannagerList (1)
          Case "Manual_Worker", "Professional": MannagerList (0)
End Select

[/vba] на
[vba]

Код

If Not Intersect(target, Range("H4:I5")) Is Nothing Then
       Select Case CStr(target)
              Case "_": MannagerList (-1)
              Case "Manager": MannagerList (1)
              Case "Manual_Worker", "Professional": MannagerList (0)
       End Select
End If

[/vba]

проблема №1 вариант с дополнительными столбцами

в ячейку M85 поставить два пробела
в диапазоне N76:N85 формула

Код

{=СТРОКА()-ЕСЛИ(ЕСЛИОШИБКА(ПОДСТАВИТЬ($M$76:$M$85;ИНДЕКС($E$39:$E$44;ПОИСКПОЗ($M$76:$M$85;$E$39:$E$44;0));"");$M$76:$M$85)<>"";75;65)}

в диапазоне O76:O85 формула

Код

создать именованный диапазон с именем List и диапазоном

Код

=СМЕЩ($O$76:$O$86;0;0;еслиошибка(ПОИСКПОЗ(" ";$O$76:$O$86;0);ПОИСКПОЗ(" ";$O$76:$O$86;0));1)

в процедуре MannagerList заменить [vba]

Код

Formula1:="=$M$76:$M$85"

[/vba] на [vba]

Код

Formula1:="=List"

[/vba]

Проблема №2

в макросе перед строкой [vba]

Код

A1 = "Organization and planning"

[/vba]
добавить строку [vba]

Код

ActiveSheet.Unprotect

[/vba]
и после строки [vba]

Код

Range("C6").Select

[/vba]
добавить строку [vba]

Код

ActiveSheet.Protect

[/vba]

ЗЫ

в процедуре Workbook_SheetChange я бы посоветовал заменить [vba]

Код

Select Case CStr(target)
          Case "_": MannagerList (-1)
          Case "Manager": MannagerList (1)
          Case "Manual_Worker", "Professional": MannagerList (0)
End Select

[/vba] на
[vba]

Код

[/vba]krosav4ig

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 04.05.2014, 04:46

Сообщениепроблема №1 вариант с дополнительными столбцами

в ячейку M85 поставить два пробела
в диапазоне N76:N85 формула

Код

{=СТРОКА()-ЕСЛИ(ЕСЛИОШИБКА(ПОДСТАВИТЬ($M$76:$M$85;ИНДЕКС($E$39:$E$44;ПОИСКПОЗ($M$76:$M$85;$E$39:$E$44;0));"");$M$76:$M$85)<>"";75;65)}

в диапазоне O76:O85 формула

Код

создать именованный диапазон с именем List и диапазоном

Код

=СМЕЩ($O$76:$O$86;0;0;еслиошибка(ПОИСКПОЗ(" ";$O$76:$O$86;0);ПОИСКПОЗ(" ";$O$76:$O$86;0));1)

в процедуре MannagerList заменить [vba]

Код

Formula1:="=$M$76:$M$85"

[/vba] на [vba]

Код

Formula1:="=List"

[/vba]

Проблема №2

в макросе перед строкой [vba]

Код

A1 = "Organization and planning"

[/vba]
добавить строку [vba]

Код

ActiveSheet.Unprotect

[/vba]
и после строки [vba]

Код

Range("C6").Select

[/vba]
добавить строку [vba]

Код

ActiveSheet.Protect

[/vba]

ЗЫ

в процедуре Workbook_SheetChange я бы посоветовал заменить [vba]

Код

Select Case CStr(target)
          Case "_": MannagerList (-1)
          Case "Manager": MannagerList (1)
          Case "Manual_Worker", "Professional": MannagerList (0)
End Select

[/vba] на
[vba]

Код

[/vba]

Автор - krosav4ig
Дата добавления - 04.05.2014 в 04:42

Дата: Воскресенье, 04.05.2014, 04:43 | Сообщение № 5

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

Ранг: Старожил

Сообщений: 2347

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

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

Excel 2007,2010,2013

да и весь код процедуры MannagerList я бы переписал как-то так
[vba]

Код

Sub MannagerList(Mang As Integer)
      Dim AA As Variant
      ActiveSheet.Unprotect
      AA = Array("Organization and planning", "Decision-making", _
          "Team building, management And development", "Delegation and control", _
          "Leadership and motivation", "Strategic thinking")
' "Manual_Worker", "Professional":
      If Mang = 0 Then
          Range("E39:E45").Value = " "
          ' Range("E46").Value = " "
          Range("B39").Value = "Professional Competencies"
          Range("D42:I44").RowHeight = 0
          'Range("D44:I46").Select
          'Range("D44:I46").Select
          ' Selection.RowHeight = 0
      ' Уставновка
          With Range("E39:E44").Validation
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                 Operator:=xlBetween, Formula1:="=List"
         End With
      'Установка в начало
          Range("E40").Select
          Range("D39").Value = 1
          Range("D40").Value = 2
          Range("D41").Value = 3
      ElseIf Mang = 1 Then
' Manager
          For i = 0 To 5
              Range("E" & 39 + i).Value = AA(i)
          Next
      'Range("E46").Value = A7
          Range("B39").Value = "Managerial Competencies"
      ' Высота строк
          Range("D40:I46").RowHeight = 14
      ' Очистка данных проверки
          With Range("E39:E46").Validation
              .Delete
              .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, _
                  Operator:=xlBetween
          End With
      ' Установка в текущее положение
          Range("E40").Select
          For i = 1 To 6
              Range("D" & 38 + i).Value = i
          Next
      ElseIf Mang = -1 Then
' *************************************************************************
' Пустое значение
' *************************************************************************
          Range("B39").Value = ""
          Range("D39:D44").Value = ""
          Range("E39:E44").Value = ""
      End If
' Следующее поле для заполнения после выбора типа
       Range("C6").Select
       ActiveSheet.Protect
End Sub

[/vba]

да и весь код процедуры MannagerList я бы переписал как-то так
[vba]

Код

[/vba]krosav4ig

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 04.05.2014, 04:55

Сообщениеда и весь код процедуры MannagerList я бы переписал как-то так
[vba]

Код

[/vba]

Автор - krosav4ig
Дата добавления - 04.05.2014 в 04:43

Дата: Четверг, 08.05.2014, 20:37 | Сообщение № 6

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

Ранг: Новичок

Сообщений: 17

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

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

Excel 2010

Спасибо. Изменил. Теперь пункт 2 работает так, как нужно.

Но с дополнительными столбцами проблема: вставил формулы, создал именованный диапазон, не получилось (( Наверное, туплю. Поправьте, если что не так.

К сообщению приложен файл: _JOAF-1-.xlsm (43.3 Kb)

Дата: Воскресенье, 11.05.2014, 02:46 | Сообщение № 7

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

Ранг: Старожил

Сообщений: 2347

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

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

Excel 2007,2010,2013

Написанные мной формулы - формулы массива. Чтобы их ввести, нужно выделить диапазон, в строку формул ввести фомулу без фигурных скобок и нажать ctrl±shift+enter

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Дата: Воскресенье, 11.05.2014, 19:49 | Сообщение № 8

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

Ранг: Новичок

Сообщений: 17

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

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

Excel 2010

Еще раз всё переписал заново, результат аналогичный

Простите, не могу понять, где проблема.

Формулы массива вводил как положено.

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

Serge_007

Дата: Воскресенье, 11.05.2014, 21:59 | Сообщение № 9

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Цитата Graceless, 11.05.2014 в 19:49, в сообщении № 8

Формулы массива вводил как положено

Цитата krosav4ig, 11.05.2014 в 02:46, в сообщении № 7

в строку формул ввести фомулу без фигурных скобок и нажать ctrl±shift+enter

Вы же сделали всё с точностью до наоборот

К сообщению приложен файл: Graceless.rar (30.2 Kb)

ЮMoney:41001419691823 | WMR:126292472390

Дата: Понедельник, 12.05.2014, 00:20 | Сообщение № 10

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

Ранг: Новичок

Сообщений: 17

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

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

Excel 2010

Спасибо большое, извините за невнимательность

Дата: Понедельник, 12.05.2014, 02:45 | Сообщение № 11

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

Ранг: Старожил

Сообщений: 2347

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

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

Excel 2007,2010,2013

небольшая поправка: в диапазоне O76:O85 формулу нужно заменить на

Код

=ТЕКСТ(ИНДЕКС(ЕСЛИОШИБКА(ПОДСТАВИТЬ($M$76:$M$85;ИНДЕКС($E$39:$E$44;ПОИСКПОЗ($M$76:$M$85;$E$39:$E$44;0));" ");$M$76:$M$85); ПОИСКПОЗ(НАИМЕНЬШИЙ(СЧЁТЕСЛИ($N$76:$N$85; "<"&$N$76:$N$85); СТРОКА($A:$A)); СЧЁТЕСЛИ($N$76:$N$85; "<"&$N$76:$N$85); 0));"")

Serge_007, скажите пожалуйста можно ли эти первые две формулы объединить в одну?

Graceless, ради интереса заглянул в ваш макрос...
у меня возникли большие сомнения по поводу строки
[vba]

Код

If Target.Count > 1 Then Target.Delete

[/vba]
чтобы было понятнее переведу ее на руссий язык
[vba]

Код

ЕСЛИ в выделенном диапазоне более 1 ячейки ТО удалить первую ячейку выделенного диапазона со сдвигом влево

[/vba]
дело в том, что в Range("E39:G41") все ячейки являются частью объединенного диапазона и привыборе любой из них на этой строке кода будет происходить удаление

заглянул в module1 и мне стало как-то непосебе

настоятельно рекомендую все что там написано заменить на чтото типа этого
[vba]

Код

Sub Clear_all()
      ActiveSheet.Unprotect
      Application.ScreenUpdating = False
          Dim rngs As Variant
          Dim rng, rng2 As Range
          rngs = Array("B39", "C4", "H4", "C6", "C7", "C8", "C9", "C10", "C12", _
              "C13", "H12", "H8", "C17", "E17:H19", "C21", "E21:H23", "C25", "E25:H31", _
              "C39", "E39:H44", "D49:D54", "D56:D58", "B62:E62", "B63:E63", "B66:E66", _
              "B67:E67", "H33:H37", "F62:I62", "F67:I67", "D64:E64", "D68:E68", "H64:I64", _
              "C2")
          Set rng = Range(rngs(0))
          Dim i As Integer
          For i = 0 To UBound(rngs)
              For Each cell In Range(rngs(i))
                  If cell.MergeCells Then
                      Set rng = Union(rng, cell.MergeArea)
                  Else
                      Set rng = Union(rng, cell)
                  End If
              Next
          Next
          rng.ClearContents
      Application.ScreenUpdating = True
      ActiveSheet.Protect
End Sub

[/vba]

и еще несколько слов про использование Worksheet_Change, Workbook_SheetChange, Worksheet_SelectionChange, Workbook_SheetSelectionChange

Worksheet_Change, Workbook_SheetChange - это процедуры, которые выполняются при любом изменении ячеек листа. Worksheet_Change запускается только при изменении на листе, в модуль которого она прописана, если она прописана не в модуль листа, оно работать не будет. Workbook_SheetChange запускается при изменениии на любом листе и эта процедура должна быть прописана в модуль книги (в вашем случае ЦяКнига). Если не планируется, что в книге будет множество однотипных листов, то я бы посоветовал перенести эту процедуру в модуль листа.

та же картина и с Worksheet_SelectionChange, Workbook_SheetSelectionChange
Worksheet_SelectionChange запускается при изменении адреса активной ячейки в том листе, в модуль которого она прописана. Workbook_SheetSelectionChange запускается при изменении адреса активной ячейки в любом листе и точно так же как и Workbook_SheetChange должна быть прописана в модуль книги (в вашем случае ЦяКнига). И так же если не планируется, что в книге будет множество однотипных листов, то я бы посоветовал перенести эту процедуру в модуль листа.

небольшая поправка: в диапазоне O76:O85 формулу нужно заменить на

Код

If Target.Count > 1 Then Target.Delete

[/vba]
чтобы было понятнее переведу ее на руссий язык
[vba]

Код

ЕСЛИ в выделенном диапазоне более 1 ячейки ТО удалить первую ячейку выделенного диапазона со сдвигом влево

настоятельно рекомендую все что там написано заменить на чтото типа этого
[vba]

Код

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

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 12.05.2014, 02:48