Здравствуйте! На этом форуме нашел макрос для составления уникального выпадающего списка. К сожалению он не отображает дробные ( с запятой) числа, а делит их в списке на два числа. Подскажите решение [vba]
Код
Sub Список() Dim uniq As New Collection Dim il As Long, i As Long, x As Integer Dim arr() If Cells(2, 5).Value = "Тема1" Then x = 1 ' If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row For i = 2 To il On Error Resume Next uniq.Add Cells(i, x), CStr(Cells(i, x)) Next i ReDim arr(1 To uniq.Count) For i = 1 To uniq.Count arr(i) = uniq(i) Next i Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",") 'Порча где-то здесь!
End Sub
[/vba]
Спасибо!
Здравствуйте! На этом форуме нашел макрос для составления уникального выпадающего списка. К сожалению он не отображает дробные ( с запятой) числа, а делит их в списке на два числа. Подскажите решение [vba]
Код
Sub Список() Dim uniq As New Collection Dim il As Long, i As Long, x As Integer Dim arr() If Cells(2, 5).Value = "Тема1" Then x = 1 ' If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row For i = 2 To il On Error Resume Next uniq.Add Cells(i, x), CStr(Cells(i, x)) Next i ReDim arr(1 To uniq.Count) For i = 1 To uniq.Count arr(i) = uniq(i) Next i Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",") 'Порча где-то здесь!
Я бы сделал список на отдельном листе Примерно так [vba]
Код
Sub Список1() If Cells(2, 5).Value = "Тема1" Then x = 1 'Номер столбца If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row Sheets(2).Columns(1).Clear With Sheets(2).Cells(1).Resize(il - 1, 1) .Value = Range(Cells(2, x), Cells(il, x)).Value .RemoveDuplicates Columns:=1, Header:=xlNo End With With Sheets(2) adr = "=" & Sheets(2).Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address End With Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=adr End Sub
[/vba]
Я бы сделал список на отдельном листе Примерно так [vba]
Код
Sub Список1() If Cells(2, 5).Value = "Тема1" Then x = 1 'Номер столбца If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row Sheets(2).Columns(1).Clear With Sheets(2).Cells(1).Resize(il - 1, 1) .Value = Range(Cells(2, x), Cells(il, x)).Value .RemoveDuplicates Columns:=1, Header:=xlNo End With With Sheets(2) adr = "=" & Sheets(2).Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address End With Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=adr End Sub
pechkin, Если это не критично, то можно в дробных числах запятую поменять на точку, т.к. запятая у вас является разделителем списка [vba]
Код
Sub Список() Dim uniq As New Collection Dim il As Long, i As Long, x As Integer Dim arr(), arg$ If Cells(2, 5).Value = "Тема1" Then x = 1 'Номер столбца If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row For i = 2 To il On Error Resume Next arg = Replace(Cells(i, x).Text, ",", ".") uniq.Add arg, arg Next i ReDim arr(1 To uniq.Count) For i = 1 To uniq.Count arr(i) = uniq(i) Next i Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",") ' End Sub
Ошибочное мнение. В коллекцию можно добавить только уникальные значения
pechkin, Если это не критично, то можно в дробных числах запятую поменять на точку, т.к. запятая у вас является разделителем списка [vba]
Код
Sub Список() Dim uniq As New Collection Dim il As Long, i As Long, x As Integer Dim arr(), arg$ If Cells(2, 5).Value = "Тема1" Then x = 1 'Номер столбца If Cells(2, 5).Value = "Тема2" Then x = 2 il = Cells(Rows.Count, x).End(xlUp).Row For i = 2 To il On Error Resume Next arg = Replace(Cells(i, x).Text, ",", ".") uniq.Add arg, arg Next i ReDim arr(1 To uniq.Count) For i = 1 To uniq.Count arr(i) = uniq(i) Next i Cells(2, 7).Validation.Delete Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:=Join(arr, ",") ' End Sub
Вы неправильно меня поняли(или я не правильно высказался)). Я не про коллекцию, а про Join и запятую. значения 1 11 1,11 дадут в списке две единички и два по одиннадцать, и поэтому
Вы неправильно меня поняли(или я не правильно высказался)). Я не про коллекцию, а про Join и запятую. значения 1 11 1,11 дадут в списке две единички и два по одиннадцать, и поэтому
boa,спасибо за участие! Пробовал менять запятую на точку - тогда при выборе "дробного значения" из списка в зависимости от формата ячеек и самого значения. получается либо дата, либо дата в числовом формате. Вернуть в ячейку число (заменив снова точку на запятую) не удается
boa,спасибо за участие! Пробовал менять запятую на точку - тогда при выборе "дробного значения" из списка в зависимости от формата ячеек и самого значения. получается либо дата, либо дата в числовом формате. Вернуть в ячейку число (заменив снова точку на запятую) не удается pechkin
StoTisted, Пробовал увы... Например при выборе числа 1,50 в выпадающем списке при числовом формате получается - 18264,00 при текстовом 18264 при общем 18264 или янв.50
StoTisted, Пробовал увы... Например при выборе числа 1,50 в выпадающем списке при числовом формате получается - 18264,00 при текстовом 18264 при общем 18264 или янв.50pechkin
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
