Dim at As Range Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("C26")) Is Nothing And Target.Count = 1 Then With UserForm2 .Show 0 .Top = .Top - 150 .ComboBox1.RowSource = "Списки!N1" End With Cancel = True End If If Not Intersect(Target, Range("C27")) Is Nothing And Target.Count = 1 Then With UserForm2 .Show 0 .Top = .Top - 150 .ComboBox1.RowSource = "Списки!P1" End With Cancel = True End If End Sub Private Sub ComboBox1_Change() Dim lstVal Application.EnableEvents = False For Each lstVal In Me.ComboBox1.List If CStr(lstVal) = Me.ComboBox1 Then Exit For Else: lstVal = "" End If Next at.Value = lstVal Application.EnableEvents = True End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C13,D13,C49")) Is Nothing Then UserForm1.Show
Dim ls Set at = Target(1) Select Case at.Column Case 5: k = 1: GoSub FillComb Case 7: k = 3: GoSub FillComb Case 9: k = 5: GoSub FillComb Case Else: HideCombo End Select Exit Sub FillComb: With Sheets(1) 'ls = Сотрудники ls = .Range(.Cells(1, k), .Cells(Rows.Count, k).End(xlUp)) 'ls = [Сотрудники].Address End With Application.EnableEvents = False With Me.ComboBox1 .Activate .Top = at.Top .Left = at.Left .Width = at.Width + 16 .Height = at.Height .Clear '.RowSource = Range("B1:B12") .List = unicList(ls) .Value = at.Value .Font.Size = Round(.Height / 2) .SelStart = 0 .SelLength = Len(.Text) End With Application.EnableEvents = True Return End Sub Private Sub HideCombo() Me.ComboBox1.Top = 0 Me.ComboBox1.Left = 0 Me.ComboBox1.Width = 0 Me.ComboBox1.Height = 0 End Sub
Private Function unicList(ls) Dim lst, i& If IsObject(ls) Then ls = ls.Value ls = IIf(IsArray(ls), ls, Array(ls)) On Error Resume Next With New Collection For Each lst In ls If Len(lst) Then For i = 1 To .Count If lst < .Item(i) Then .Add lst, CStr(lst), before:=i: Exit For Next .Add lst, CStr(lst) End If Next ReDim ls(1 To .Count) For i = 1 To .Count: ls(i) = .Item(i): Next unicList = ls End With End Function
[/vba]
Вот весь код, однако не получается [vba]
Код
= [Сотрудники].Address
[/vba]
[vba]
Код
Dim at As Range Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("C26")) Is Nothing And Target.Count = 1 Then With UserForm2 .Show 0 .Top = .Top - 150 .ComboBox1.RowSource = "Списки!N1" End With Cancel = True End If If Not Intersect(Target, Range("C27")) Is Nothing And Target.Count = 1 Then With UserForm2 .Show 0 .Top = .Top - 150 .ComboBox1.RowSource = "Списки!P1" End With Cancel = True End If End Sub Private Sub ComboBox1_Change() Dim lstVal Application.EnableEvents = False For Each lstVal In Me.ComboBox1.List If CStr(lstVal) = Me.ComboBox1 Then Exit For Else: lstVal = "" End If Next at.Value = lstVal Application.EnableEvents = True End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C13,D13,C49")) Is Nothing Then UserForm1.Show
Dim ls Set at = Target(1) Select Case at.Column Case 5: k = 1: GoSub FillComb Case 7: k = 3: GoSub FillComb Case 9: k = 5: GoSub FillComb Case Else: HideCombo End Select Exit Sub FillComb: With Sheets(1) 'ls = Сотрудники ls = .Range(.Cells(1, k), .Cells(Rows.Count, k).End(xlUp)) 'ls = [Сотрудники].Address End With Application.EnableEvents = False With Me.ComboBox1 .Activate .Top = at.Top .Left = at.Left .Width = at.Width + 16 .Height = at.Height .Clear '.RowSource = Range("B1:B12") .List = unicList(ls) .Value = at.Value .Font.Size = Round(.Height / 2) .SelStart = 0 .SelLength = Len(.Text) End With Application.EnableEvents = True Return End Sub Private Sub HideCombo() Me.ComboBox1.Top = 0 Me.ComboBox1.Left = 0 Me.ComboBox1.Width = 0 Me.ComboBox1.Height = 0 End Sub
Private Function unicList(ls) Dim lst, i& If IsObject(ls) Then ls = ls.Value ls = IIf(IsArray(ls), ls, Array(ls)) On Error Resume Next With New Collection For Each lst In ls If Len(lst) Then For i = 1 To .Count If lst < .Item(i) Then .Add lst, CStr(lst), before:=i: Exit For Next .Add lst, CStr(lst) End If Next ReDim ls(1 To .Count) For i = 1 To .Count: ls(i) = .Item(i): Next unicList = ls End With End Function
Пример не мой но смысл тот Нужно в список загнать данные из именованного диапазона. И еще вопрос почему если этот же combobox на форме то у него есть свойство rowsource, а если на листе его нет?
Пример не мой но смысл тот Нужно в список загнать данные из именованного диапазона. И еще вопрос почему если этот же combobox на форме то у него есть свойство rowsource, а если на листе его нет?skais
Manyasha,sboy - спасибо помогли! Однако у меня проблема - при указании диапазона через формулу смещ (для зависимых списков), оно воспринимает как пустое, хотя сам диапазон рабочий если использовать обычный выпадающий список или через combobox на userform. Посмотрите пожалуйста, в чем причина?
Manyasha,sboy - спасибо помогли! Однако у меня проблема - при указании диапазона через формулу смещ (для зависимых списков), оно воспринимает как пустое, хотя сам диапазон рабочий если использовать обычный выпадающий список или через combobox на userform. Посмотрите пожалуйста, в чем причина?skais
sboy не работает,не могли бы Вы в самом файле посмотреть, обычный диапазон он воспринимает по Вашему первому примеру, а вот со смещ нет! Combo в E7 Зависит от D7
sboy не работает,не могли бы Вы в самом файле посмотреть, обычный диапазон он воспринимает по Вашему первому примеру, а вот со смещ нет! Combo в E7 Зависит от D7skais
Сообщение отредактировал skais - Понедельник, 05.03.2018, 17:57
skais, для Вашей задачи не подходит использование имени. Вам нужно отказаться от использования имени и использовать что-нибудь другое.
Цитата из справки: RefersToRange If the Name object doesn't refer to a range (for example, if it refers to a constant or a formula), this property fails.
Что означает, что если в имени используется формула (это в Вашем случае), то свойство fails, т.е. не работает.
skais, для Вашей задачи не подходит использование имени. Вам нужно отказаться от использования имени и использовать что-нибудь другое.
Цитата из справки: RefersToRange If the Name object doesn't refer to a range (for example, if it refers to a constant or a formula), this property fails.
Что означает, что если в имени используется формула (это в Вашем случае), то свойство fails, т.е. не работает.Karataev