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

Вход

Регистрация

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

 

= Мир MS Excel/Дробное число в выпадающем списке - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дробное число в выпадающем списке
Дробное число в выпадающем списке
pechkin Дата: Пятница, 08.06.2018, 08:16 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 255
Репутация: 31 ±
Замечаний: 0% ±

2003
Здравствуйте! На этом форуме нашел макрос для составления уникального выпадающего списка. К сожалению он не отображает дробные ( с запятой) числа, а делит их в списке на два числа. Подскажите решение
[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]

Спасибо!
К сообщению приложен файл: 3411890.xls(30.0 Kb)


Сообщение отредактировал pechkin - Пятница, 08.06.2018, 08:19
 
Ответить
СообщениеЗдравствуйте! На этом форуме нашел макрос для составления уникального выпадающего списка. К сожалению он не отображает дробные ( с запятой) числа, а делит их в списке на два числа. Подскажите решение
[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]

Спасибо!

Автор - pechkin
Дата добавления - 08.06.2018 в 08:16
китин Дата: Пятница, 08.06.2018, 08:37 | Сообщение № 2
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5071
Репутация: 807 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
неправильно


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538


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

Автор - китин
Дата добавления - 08.06.2018 в 08:37
sboy Дата: Пятница, 08.06.2018, 09:22 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Этот код не создаст список уникальных значений...
 
Ответить
СообщениеДобрый день.
Этот код не создаст список уникальных значений...

Автор - sboy
Дата добавления - 08.06.2018 в 09:22
sboy Дата: Пятница, 08.06.2018, 09:56 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
Я бы сделал список на отдельном листе
Примерно так
[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]
К сообщению приложен файл: 2395186.xls(44.5 Kb)
 
Ответить
СообщениеЯ бы сделал список на отдельном листе
Примерно так
[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]

Автор - sboy
Дата добавления - 08.06.2018 в 09:56
pechkin Дата: Пятница, 08.06.2018, 10:43 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 255
Репутация: 31 ±
Замечаний: 0% ±

2003
Спасибо за ответ. К сожалению Ваш макрос выдает ошибку на строке [vba]
Код
.RemoveDuplicates Columns:=1, Header:=xlNo
[/vba] В файле, который Вы приложили почему-то у меня нет списка в ячейке...
 
Ответить
СообщениеСпасибо за ответ. К сожалению Ваш макрос выдает ошибку на строке [vba]
Код
.RemoveDuplicates Columns:=1, Header:=xlNo
[/vba] В файле, который Вы приложили почему-то у меня нет списка в ячейке...

Автор - pechkin
Дата добавления - 08.06.2018 в 10:43
sboy Дата: Пятница, 08.06.2018, 10:46 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
Очень странно, проверил - работает
скачал, то, что прикрепил - тоже работает %)
Excel у Вас 2003. Там нет удалить дубликаты


Сообщение отредактировал sboy - Пятница, 08.06.2018, 10:47
 
Ответить
СообщениеОчень странно, проверил - работает
скачал, то, что прикрепил - тоже работает %)
Excel у Вас 2003. Там нет удалить дубликаты

Автор - sboy
Дата добавления - 08.06.2018 в 10:46
китин Дата: Пятница, 08.06.2018, 10:47 | Сообщение № 7
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5071
Репутация: 807 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
sboy, Сергей а прокомментировать плиз pray pray pray

[p.s.]у меня тоже все работает


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538


Сообщение отредактировал китин - Пятница, 08.06.2018, 10:47
 
Ответить
Сообщениеsboy, Сергей а прокомментировать плиз pray pray pray

[p.s.]у меня тоже все работает

Автор - китин
Дата добавления - 08.06.2018 в 10:47
sboy Дата: Пятница, 08.06.2018, 10:49 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
китин, что-то конкретно? а то весь код лениво :)
pechkin, тогда можно через словарик, потом выгружать, чуть позже смогу накидать пример
 
Ответить
Сообщениекитин, что-то конкретно? а то весь код лениво :)
pechkin, тогда можно через словарик, потом выгружать, чуть позже смогу накидать пример

Автор - sboy
Дата добавления - 08.06.2018 в 10:49
pechkin Дата: Пятница, 08.06.2018, 10:55 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 255
Репутация: 31 ±
Замечаний: 0% ±

2003
Действительно странно. Скачал еще раз Ошибка 438 Object doesn"t support this property or method
 
Ответить
СообщениеДействительно странно. Скачал еще раз Ошибка 438 Object doesn"t support this property or method

Автор - pechkin
Дата добавления - 08.06.2018 в 10:55
китин Дата: Пятница, 08.06.2018, 10:55 | Сообщение № 10
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5071
Репутация: 807 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
второй витч
[vba]
Код
With Sheets(2)
            adr = "=" & Sheets(2).Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address
        End With
[/vba]


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениевторой витч
[vba]
Код
With Sheets(2)
            adr = "=" & Sheets(2).Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address
        End With
[/vba]

Автор - китин
Дата добавления - 08.06.2018 в 10:55
sboy Дата: Пятница, 08.06.2018, 11:01 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
собираем адрес в строку
в результате получается
[vba]
Код
adr = "=Лист2!$A$1:$A$12"
[/vba]
и подсовываем это в источник для списка
Sheets(2) лишний, забыл убрать вот так правильно
[vba]
Код
With Sheets(2)
            adr = "=" & .Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address
        End With
[/vba]


Сообщение отредактировал sboy - Пятница, 08.06.2018, 11:03
 
Ответить
Сообщениесобираем адрес в строку
в результате получается
[vba]
Код
adr = "=Лист2!$A$1:$A$12"
[/vba]
и подсовываем это в источник для списка
Sheets(2) лишний, забыл убрать вот так правильно
[vba]
Код
With Sheets(2)
            adr = "=" & .Name & "!" & Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp)).Address
        End With
[/vba]

Автор - sboy
Дата добавления - 08.06.2018 в 11:01
китин Дата: Пятница, 08.06.2018, 11:17 | Сообщение № 12
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5071
Репутация: 807 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
спасибо!!!


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
Сообщениеспасибо!!!

Автор - китин
Дата добавления - 08.06.2018 в 11:17
boa Дата: Пятница, 08.06.2018, 11:24 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 27 ±
Замечаний: 0% ±

2013, 365
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
[/vba]

Этот код не создаст список уникальных значений...

Ошибочное мнение. В коллекцию можно добавить только уникальные значения


 
Ответить
Сообщение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
[/vba]

Этот код не создаст список уникальных значений...

Ошибочное мнение. В коллекцию можно добавить только уникальные значения

Автор - boa
Дата добавления - 08.06.2018 в 11:24
sboy Дата: Пятница, 08.06.2018, 12:03 | Сообщение № 14
Группа: Друзья
Ранг: Старожил
Сообщений: 2105
Репутация: 604 ±
Замечаний: 0% ±

Excel 2010
Ошибочное мнение

Вы неправильно меня поняли(или я не правильно высказался)). Я не про коллекцию, а про Join и запятую.
значения 1 11 1,11
дадут в списке две единички и два по одиннадцать, и поэтому
код не создаст список уникальных
 
Ответить
Сообщение
Ошибочное мнение

Вы неправильно меня поняли(или я не правильно высказался)). Я не про коллекцию, а про Join и запятую.
значения 1 11 1,11
дадут в списке две единички и два по одиннадцать, и поэтому
код не создаст список уникальных

Автор - sboy
Дата добавления - 08.06.2018 в 12:03
StoTisteg Дата: Пятница, 08.06.2018, 12:53 | Сообщение № 15
Группа: Авторы
Ранг: Старожил
Сообщений: 1016
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
В коллекцию можно добавить только уникальные значения

[vba]
Код
Sub test()

   Dim col As Collection
   Dim i As Integer
   
   Set col = New Collection
   col.Add 1
   col.Add 1
   For i = 1 To col.Count
      Cells(i, 1).Value = col(i)
   Next i

End Sub
[/vba]
Распрекрасно добавляются не уникальные.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение
В коллекцию можно добавить только уникальные значения

[vba]
Код
Sub test()

   Dim col As Collection
   Dim i As Integer
   
   Set col = New Collection
   col.Add 1
   col.Add 1
   For i = 1 To col.Count
      Cells(i, 1).Value = col(i)
   Next i

End Sub
[/vba]
Распрекрасно добавляются не уникальные.

Автор - StoTisteg
Дата добавления - 08.06.2018 в 12:53
pechkin Дата: Пятница, 08.06.2018, 12:59 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 255
Репутация: 31 ±
Замечаний: 0% ±

2003
boa,спасибо за участие! Пробовал менять запятую на точку - тогда при выборе "дробного значения" из списка в зависимости от формата ячеек и самого значения. получается либо дата, либо дата в числовом формате. Вернуть в ячейку число (заменив снова точку на запятую) не удается %)
 
Ответить
Сообщениеboa,спасибо за участие! Пробовал менять запятую на точку - тогда при выборе "дробного значения" из списка в зависимости от формата ячеек и самого значения. получается либо дата, либо дата в числовом формате. Вернуть в ячейку число (заменив снова точку на запятую) не удается %)

Автор - pechkin
Дата добавления - 08.06.2018 в 12:59
StoTisteg Дата: Пятница, 08.06.2018, 13:01 | Сообщение № 17
Группа: Авторы
Ранг: Старожил
Сообщений: 1016
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
pechkin, а если ячейке принудительно задать числовой формат? Или даже текстовый.


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Пятница, 08.06.2018, 13:02
 
Ответить
Сообщениеpechkin, а если ячейке принудительно задать числовой формат? Или даже текстовый.

Автор - StoTisteg
Дата добавления - 08.06.2018 в 13:01
boa Дата: Пятница, 08.06.2018, 13:38 | Сообщение № 18
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 27 ±
Замечаний: 0% ±

2013, 365
StoTisteg,

Распрекрасно добавляются не уникальные.

потому что без ключа добавляете
Col.Add [значение], CStr([ключ])


 
Ответить
СообщениеStoTisteg,

Распрекрасно добавляются не уникальные.

потому что без ключа добавляете
Col.Add [значение], CStr([ключ])

Автор - boa
Дата добавления - 08.06.2018 в 13:38
pechkin Дата: Пятница, 08.06.2018, 13:44 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 255
Репутация: 31 ±
Замечаний: 0% ±

2003
StoTisted, Пробовал увы... Например при выборе числа 1,50 в выпадающем списке при числовом формате получается - 18264,00 при текстовом 18264 при общем 18264 или янв.50
 
Ответить
СообщениеStoTisted, Пробовал увы... Например при выборе числа 1,50 в выпадающем списке при числовом формате получается - 18264,00 при текстовом 18264 при общем 18264 или янв.50

Автор - pechkin
Дата добавления - 08.06.2018 в 13:44
boa Дата: Пятница, 08.06.2018, 13:50 | Сообщение № 20
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 27 ±
Замечаний: 0% ±

2013, 365
pechkin,
не знаю как у вас не получается
формат ячейки на текстовый надо поменять в ячейке, в которой выпадающий список.
К сообщению приложен файл: 1217784.xls(53.5 Kb)




Сообщение отредактировал boa - Пятница, 08.06.2018, 13:54
 
Ответить
Сообщениеpechkin,
не знаю как у вас не получается
формат ячейки на текстовый надо поменять в ячейке, в которой выпадающий список.

Автор - boa
Дата добавления - 08.06.2018 в 13:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дробное число в выпадающем списке
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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