Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Оптимизация Combobox'а - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Оптимизация Combobox'а (Макросы Sub)
Оптимизация Combobox'а
Skynet Дата: Вторник, 02.07.2013, 09:11 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
есть проблема, решение которой не могу найти, гугл не дал желаемых результатов. Есть комбобокс с диапазоном А1:А20, который частично заполнен позициями и будет дальше заполнятся по мере надобности. Нужно по средствам vba заставить комбобокс отображать только заполненные позиции без пустых строк. Заранее спасибо.
К сообщению приложен файл: 7470417.xlsm (13.4 Kb)
 
Ответить
Сообщениеесть проблема, решение которой не могу найти, гугл не дал желаемых результатов. Есть комбобокс с диапазоном А1:А20, который частично заполнен позициями и будет дальше заполнятся по мере надобности. Нужно по средствам vba заставить комбобокс отображать только заполненные позиции без пустых строк. Заранее спасибо.
Автор - Skynet
Дата добавления - 02.07.2013 в 09:11
Саня Дата: Вторник, 02.07.2013, 10:03 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 1068
Репутация: 560 ±
Замечаний: 0% ±

XL 2016
св-во ListFillRange очистить и в модуль листа "Лист1" (на котором находится комбобокс):
[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
     Dim c As Range, n As Integer, aList()
     For Each c In Sheets("Лист2").Range("A1:A20")
         If Len(c.Value) > 0 Then
             n = n + 1
             ReDim Preserve aList(1 To n)
             aList(n) = c.Value
         End If
     Next c
     ComboBox1.List = aList
End Sub
[/vba]
 
Ответить
Сообщениесв-во ListFillRange очистить и в модуль листа "Лист1" (на котором находится комбобокс):
[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
     Dim c As Range, n As Integer, aList()
     For Each c In Sheets("Лист2").Range("A1:A20")
         If Len(c.Value) > 0 Then
             n = n + 1
             ReDim Preserve aList(1 To n)
             aList(n) = c.Value
         End If
     Next c
     ComboBox1.List = aList
End Sub
[/vba]
Автор - Саня
Дата добавления - 02.07.2013 в 10:03
Skynet Дата: Вторник, 02.07.2013, 10:46 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Саня, ты маг и чародей, я бился очень догло, методом проб и ошибок, ничего не выходило, спасибо тебе добрый человек. поставил плюсик.
 
Ответить
СообщениеСаня, ты маг и чародей, я бился очень догло, методом проб и ошибок, ничего не выходило, спасибо тебе добрый человек. поставил плюсик.
Автор - Skynet
Дата добавления - 02.07.2013 в 10:46
Skynet Дата: Пятница, 05.07.2013, 07:56 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
задача усложнилась, есть 2 комбобокса на листе1, у первого диапазон А1:А20, у второго А21:А40, как сделать чтобы было всё хорошо?
 
Ответить
Сообщениезадача усложнилась, есть 2 комбобокса на листе1, у первого диапазон А1:А20, у второго А21:А40, как сделать чтобы было всё хорошо?
Автор - Skynet
Дата добавления - 05.07.2013 в 07:56
Skynet Дата: Пятница, 05.07.2013, 08:06 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
преобразовал в

[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
Dim c As Range, n As Integer, aList()
For Each c In Sheets("лист2").Range("A1:A20")
If Len(c.Value) > 0 Then
n = n + 1
ReDim Preserve aList(1 To n)
aList(n) = c.Value
End If
Next c
ComboBox1.List = aList

Dim d As Range, o As Integer
For Each d In Sheets("лист2").Range("A21:A40")
If Len(d.Value) > 0 Then
o = o + 1
ReDim Preserve aList(1 To o)
aList(o) = d.Value
End If
Next d
ComboBox2.List = aList

End Sub
[/vba]

выдает рантайм ерор 9


Сообщение отредактировал Skynet - Пятница, 05.07.2013, 08:06
 
Ответить
Сообщениепреобразовал в

[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
Dim c As Range, n As Integer, aList()
For Each c In Sheets("лист2").Range("A1:A20")
If Len(c.Value) > 0 Then
n = n + 1
ReDim Preserve aList(1 To n)
aList(n) = c.Value
End If
Next c
ComboBox1.List = aList

Dim d As Range, o As Integer
For Each d In Sheets("лист2").Range("A21:A40")
If Len(d.Value) > 0 Then
o = o + 1
ReDim Preserve aList(1 To o)
aList(o) = d.Value
End If
Next d
ComboBox2.List = aList

End Sub
[/vba]

выдает рантайм ерор 9
Автор - Skynet
Дата добавления - 05.07.2013 в 08:06
AndreTM Дата: Пятница, 05.07.2013, 10:21 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 501 ±
Замечаний: 0% ±

2003 & 2010
Skynet, вставь перед вторым куском кода (скопированным)
[vba]
Код
Dim aList()
[/vba]или используй другой массив...

Впрочем...
[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
      MakeList Sheets("Лист2").Range("A1:A20"), ComboBox1
      MakeList Sheets("Лист2").Range("A21:A40"), ComboBox2
End Sub

Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
       Dim c As Range, n As Integer, aList()
       For Each c In Sour.Cells
           If Len(c.Value) > 0 Then
               n = n + 1
               ReDim Preserve aList(1 To n)
               aList(n) = c.Value
           End If
       Next c
       Dest.List = aList
End Sub
[/vba]

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Сообщение отредактировал AndreTM - Пятница, 05.07.2013, 10:23
 
Ответить
СообщениеSkynet, вставь перед вторым куском кода (скопированным)
[vba]
Код
Dim aList()
[/vba]или используй другой массив...

Впрочем...
[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
      MakeList Sheets("Лист2").Range("A1:A20"), ComboBox1
      MakeList Sheets("Лист2").Range("A21:A40"), ComboBox2
End Sub

Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
       Dim c As Range, n As Integer, aList()
       For Each c In Sour.Cells
           If Len(c.Value) > 0 Then
               n = n + 1
               ReDim Preserve aList(1 To n)
               aList(n) = c.Value
           End If
       Next c
       Dest.List = aList
End Sub
[/vba]
Автор - AndreTM
Дата добавления - 05.07.2013 в 10:21
Skynet Дата: Пятница, 05.07.2013, 10:38 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
щас разберусь, какие то чудеса в файле. пример работает, а основной файл выдает ошибку "run time error 70 permission denied"


Сообщение отредактировал Skynet - Пятница, 05.07.2013, 10:39
 
Ответить
Сообщениещас разберусь, какие то чудеса в файле. пример работает, а основной файл выдает ошибку "run time error 70 permission denied"
Автор - Skynet
Дата добавления - 05.07.2013 в 10:38
Skynet Дата: Пятница, 05.07.2013, 10:52 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
AndreTM твой код в файле примера тоже работает, а в основном файле та же ошибка

основной файл, код:

[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
MakeList Sheets("База данных 1").Range("S3:S99"), ComboBox6
MakeList Sheets("База данных 1").Range("S100:S199"), ComboBox8
MakeList Sheets("База данных 1").Range("S200:S299"), ComboBox9
MakeList Sheets("База данных 1").Range("S200:S299"), ComboBox12
End Sub

Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
Dim c As Range, n As Integer, aList()
For Each c In Sour.Cells
If Len(c.Value) > 0 Then
n = n + 1
ReDim Preserve aList(1 To n)
aList(n) = c.Value
End If
Next c
Dest.List = aList
End Sub

Private Sub Worksheet_Calculate()

Worksheet_Change Range("V1")
Worksheet_Change Range("Y7")

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

' скрытие строк второго листа на вкладке "Загружения в СКАД"

If Target.Address = [V1].Address Then
Select Case Target
Case 0
Sheets("Загружения в SCAD").Rows("53:105").Hidden = True
Case 1
Sheets("Загружения в SCAD").Rows("53:105").Hidden = False
End Select
End If

' скрытие элементов в зависимости от норм расчета (ПУЭ 6, ПУЭ 7)

If Target.Address = [Y7].Address Then
Select Case Target
Case 0
Sheets("Нагрузки на опору").ComboBox4.Visible = False
Sheets("Нагрузки на опору").ComboBox15.Visible = True
Sheets("Нагрузки на опору").ComboBox10.Visible = False
Sheets("Нагрузки на опору").ComboBox11.Visible = False
Case 1
Sheets("Нагрузки на опору").ComboBox4.Visible = True
Sheets("Нагрузки на опору").ComboBox15.Visible = False
Sheets("Нагрузки на опору").ComboBox10.Visible = True
Sheets("Нагрузки на опору").ComboBox11.Visible = True
End Select
End If

End Sub
[/vba]
 
Ответить
СообщениеAndreTM твой код в файле примера тоже работает, а в основном файле та же ошибка

основной файл, код:

[vba]
Код
Option Explicit

Private Sub Worksheet_Activate()
MakeList Sheets("База данных 1").Range("S3:S99"), ComboBox6
MakeList Sheets("База данных 1").Range("S100:S199"), ComboBox8
MakeList Sheets("База данных 1").Range("S200:S299"), ComboBox9
MakeList Sheets("База данных 1").Range("S200:S299"), ComboBox12
End Sub

Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
Dim c As Range, n As Integer, aList()
For Each c In Sour.Cells
If Len(c.Value) > 0 Then
n = n + 1
ReDim Preserve aList(1 To n)
aList(n) = c.Value
End If
Next c
Dest.List = aList
End Sub

Private Sub Worksheet_Calculate()

Worksheet_Change Range("V1")
Worksheet_Change Range("Y7")

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

' скрытие строк второго листа на вкладке "Загружения в СКАД"

If Target.Address = [V1].Address Then
Select Case Target
Case 0
Sheets("Загружения в SCAD").Rows("53:105").Hidden = True
Case 1
Sheets("Загружения в SCAD").Rows("53:105").Hidden = False
End Select
End If

' скрытие элементов в зависимости от норм расчета (ПУЭ 6, ПУЭ 7)

If Target.Address = [Y7].Address Then
Select Case Target
Case 0
Sheets("Нагрузки на опору").ComboBox4.Visible = False
Sheets("Нагрузки на опору").ComboBox15.Visible = True
Sheets("Нагрузки на опору").ComboBox10.Visible = False
Sheets("Нагрузки на опору").ComboBox11.Visible = False
Case 1
Sheets("Нагрузки на опору").ComboBox4.Visible = True
Sheets("Нагрузки на опору").ComboBox15.Visible = False
Sheets("Нагрузки на опору").ComboBox10.Visible = True
Sheets("Нагрузки на опору").ComboBox11.Visible = True
End Select
End If

End Sub
[/vba]
Автор - Skynet
Дата добавления - 05.07.2013 в 10:52
Skynet Дата: Пятница, 05.07.2013, 11:23 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Господа, прошу меня понять и простить, оба варианта рабочие, просто я из нужных комбобоксов в окне свойств ListFillRange не удалил старую ссылку на диапазон.
 
Ответить
СообщениеГоспода, прошу меня понять и простить, оба варианта рабочие, просто я из нужных комбобоксов в окне свойств ListFillRange не удалил старую ссылку на диапазон.
Автор - Skynet
Дата добавления - 05.07.2013 в 11:23
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Оптимизация Combobox'а (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!