вспомнила чтото было   спасибо

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

неправильно сказала  
сделать визуально определенные пункты в 0 - fmListStylePlain  
а остальные в 1 - fmListStyleOption

еще вопрос - можно ли в одном окне листбокса  
сделать выбранные пункты в 0 - fmListStylePlain  
а остальные в 1 - fmListStyleOption  
 
те строчка  
ListBox1.ListStyle = fmListStylePlain  работает  
 
а так ListBox1.ListStyle(i)= fmListStylePlain    
или ListBox1.ListStyle(i)= 0 нет  
 
или так невозможно сделать ?

End If только убрать

так сделала - зависы пропали вроде работает    
 
Private Sub ListBox1_Change()  
Dim z As Integer, k&  
 
With Sheets("Лист3")  
For k = 3 To Cells(2, Columns.Count).End(xlToRight).Column  
z = .Cells(2, k).End(xlToLeft).Column - 3  
If ListBox1.ListIndex = z And ListBox1.Selected(z) = True Then ListBox1.Selected(z) = False  
End If  
Next  
End With  
End Sub

вариант с комбо есть    
но при этом не видно всего списка      
а только подгруппу в группе    
если группа в комбо а подгруппа в листбоксе  
 
пользователь в моем понимании как дополнение к комбо  
визуально доллжен развернуть весь список  
чтоб исключить ошибки и пр  
 
и проблема  
чтоб весь список посмотреть пользователь  
10 раз на разные комбо нажмет чтоб весь список посмотреть - это неудобно  
 
 
те макрос никак не поправить ?

ничего не поняла  
пункт группы должен быть чтобы пользователь визуально    
видел заголовок группы в ListBox  
 
тоько по условиям его нельзя было выделить  
а подгруппы можно

сделала так работает но криво както  
форма зависает если кликаю на пунктах на которых запрещено выделение  
 
Private Sub ListBox1_Change()  
Dim z As Integer, k&  
 
With Sheets("Лист3")  
For k = 3 To Cells(2, Columns.Count).End(xlToRight).Column  
z = .Cells(2, k).End(xlToLeft).Column - 3  
If ListBox1.ListIndex = z Then ListBox1.Selected(z) = False  
Next  
End With  
End Sub  
 
пример приложила

проверила еще  
Me.ListBox1.Locked = True  работает  
 
а вот    
For j = 0 To Me.ListBox1.ListCount - 1  
Me.ListBox1.Locked(j) = True  
Next  
 
нет к сожалению (чтоб заблокировать отдельные пункты)

одну ошибку нашла  
Private Sub ListBox1_Change()  
Dim j As Integer, k  
k = Range(Cells(2, 3), Cells(2, Columns.Count).End(xlToLeft)).Column  
j = Cells(3, k).End(xlToRight).Column  
If ListBox1.ListIndex = j Then  
ListBox1.Selected(j) = False  
End If  
End Sub  
 
или так  
 
Private Sub ListBox1_Change()  
Dim j As Integer, k  
k = Range(Cells(2, 3), Cells(2, Columns.Count).End(xlToLeft)).Column  
j = Cells(3, k).End(xlToRight).Column  
If ListBox1.ListIndex = j Then  
ListBox1.Selected(ListBox1.ListIndex) = False  
End If  
End Sub  
 
это же в основе ваш вариант вроде просто 5 и 6 заменила переменной  
но все равно не реагирует  
 
ваш вариант конечно работает

Private Sub ListBox1_Change()  
Dim j As Integer, k  
k = Range(Cells(2, 3), Cells(2, Columns.Count).End(xlToLeft)).Column  
j = Cells(2, k).End(xlToRight).Column  
If ListBox1.ListIndex = j Then  
ListBox1.Selected(j) = False  
End If  
End Sub  
 
написала макрос для своего файла но не работает как надо

Me.ListBox1.Locked(i) = True  
работает ли это свойство в VBA ?

спасибо Юрий и слэн помогло    
еще вопрос если можно  
нужно запретить выделение определенных пунктов ListBox  
вижу 2 пути  
1-при каждом цикле принудительно стирать отмеченное в этих пунктах  
по Me.ListBox1.Selected(i) = False  
2-есть ли более простое решение как будет выглядеть команда запрета выделения скажем для 4 5 7 пункта ListBox или i-пункта?

добавила    
Dim k As Integer  
For k = 0 To Me.ListBox1.ListCount - 1  
   If Me.ListBox1.Selected(k) Then x = x + 1  
   If x = 0 Then MsgBox "Не отмечены клиенты !"  
   Exit Sub  
Next  
 
отмечено или неотмечено без разницы все равно MsgBox вылазит  
 
файл с примером приложила

и еще вопрос если задано в свойствах  
2 - fmMultiSelectExtended  
то    
If Me.ListBox1.ListIndex = -1 Then MsgBox "Не отмечены пункты в ListBox !"  
сработает или нет ?

по справке ListBox    
SelCount отображает число выбранных пунктов элемента ListBox, если значение свойства MultSelect установлено равным 1 (Simple) или 2 (Extended). Обычно это свойство используют вместе с массивом Selected для работы с выбранными пунктами элемента  
 
как правильно прописать условие  
For i = 0 To Me.ListBox1.ListCount - 1  
If Me.ListBox1.SelCount(i) > 0 Then ....  дает ошибку  
 
 
и второй вопрос можно ли так еще на основе ListIndex  
If Me.ListBox1.ListIndex = -1 Then ....  
If Me.ListBox1.ListIndex >= 0 Then ...

Пытаюсь с помощью Combobox и Listbox  
сделать группы и подгруппы из строки таблицы  
 
Сделала по примеру с форума макрос  в Private Sub ComboBox1_Change()  
он показывает только одно значение в группе а нужно несколько  
 
вроде все правильно но не работает как надо  
 
пример выложила

также спасибо всем участникам форума за помощь !

я то хотела так сделать  
если в диапазоне таблицы есть значение совпадающее со значением ListBox1  
и в столбце с этим значением в строке 3 по названию выделить пункт ListBox2

вопрос такой  
ListBox1.Selected(7) = True  - 7 пункт ListBox (начиная с 0)выделен  
 
если в 7 пункте листбокса написано например "Клиент7"  
то как по названию будет  
 
ListBox1.Selected.Name "Клиент7"  
 
те как пункт листбокса описать не по порядковому номеру пункта  
а по названию пункта

применительно к таблице и 9 строке  
 
Private Sub UserForm_Initialize()  
For i = 0 To Me.ListBox2.ListCount - 1  
k = i + 3  
If Cells(9, k).Value = "777" Then  
Me.ListBox2.Selected(i) = True  
Else: Me.ListBox2.Selected(i) = False  
End If  
Next  
End Sub  
 
осталось еще поиск выбранных значений в ListBox1

Private Sub UserForm_Initialize()  
For i = 0 To Me.ListBox1.ListCount - 1  
If Cells(H9).Value = "777" Then  
Me.ListBox2.Selected(6) = True  
End If  
Next  
End Sub  
 
видимо както так  
по этому пути

номенклатура большая товара в прайсе  и клиентов разных тоже по новой набирать можно конечно но лучше снять/добавить в ListBox2

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

попробовала работает и рамки рисует - здорово  
Hugo спасибо что помогли  
 
решить обратную задачу осталось  
при UserForm_Initialize и выборе товара в ListBox1  
в ListBox2 автоматически галки ставятся на позициях  
если данное значение ListBox1 уже  
занесено ранее в таблицу с заголовком позиции ListBox2  
 
те если форма запустилась затем выбираешь в ListBox1 например 777  
то если 777 есть уже в таблице в колонках Клиент5 Клиент6 Клиент7 Клиент9  
(ранее было занесено)  
то автоматически в форме появляются галки в ListBox2 на поз. Клиент5 Клиент6 Клиент7 Клиент9

а если на основе вашего макроса примерно так  
Dim i As Integer, a(), b, r As Range, r1 As Range, r2 As Range  
Set r = Intersect([C3:IV1000], ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub  
iRow = r.Row + r.Rows.Count  
iClm1 = r.Column  
iClm2 = r.Column + r.Columns.Count - 1  
r1 = Cells(iRow, iClm1)  
r2 = Cells(iRow, iClm2)  
a = [r1:r2].Value 'берём данные в массив
 
For i = 0 To Me.ListBox1.ListCount - 1  
If Me.ListBox1.Selected(i) = True Then  
b = Me.ListBox1.List(i) 'определяем заносимое значение  
End If  
Next  
 
For i = 0 To Me.ListBox2.ListCount - 1  
If Me.ListBox2.Selected(i) = True Then  
a(1, 1 + i) = b 'меняем значение в массиве  
End If  
Next  
 
[r1:r2].Value = a 'выгружаем массив
End Sub  
 
только у меня на r1 и r2 ругается видимо неправильно

получается что вносить надо построчно в последнюю незаполненную строку  
начиная с 4 строки  
те один раз внесли в 4 строку что    
потом следующая незаполненная 5 заполняется    
потом 6    
на каждый клик и тд

Private Sub CommandButton1_Click()  
Dim i As Integer, j As Integer, n As Integer  
j = 3  
For i = 0 To Me.ListBox1.ListCount - 1  
           If Me.ListBox1.Selected(i) = True Then  
               For n = 0 To Me.ListBox2.ListCount - 1  
               If Me.ListBox2.Selected(n) = True Then  
                  Лист2.Cells(j + 1, n) = ListBox1.List(i)  
                  j = j + 1  
         End If    
         Next  
         End If  
     Next  
End Sub  
 
вот так заработало и была путаница в наименованиях листов поправила  
значения в колонки вставляет но со смещением почему то

j = 3  
For i = 0 To ListBox1.ListCount - 1  
           If ListBox1.Selected(i) = True Then  
               For n = 0 To ListBox2.ListCount - 1  
               If ListBox1.Selected(n) = True Then  
                  Лист2.Cells(j + 1, n) = ListBox2.List(n)  
                  j = j + 1  
         End If  
         Next n  
     End If  
     Next i  
End Sub  
 
так тоже не идет с ошибкой