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

Вход

Регистрация

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

 

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

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

2003
Таки да,boa! Это понятно! Вопрос теперь встал в том как вернуть число (цифры с запятой а не точкой)
 
Ответить
СообщениеТаки да,boa! Это понятно! Вопрос теперь встал в том как вернуть число (цифры с запятой а не точкой)

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

Excel 2010
Вот вариант со словариком
[vba]
Код
Sub Список()
Dim il As Long, i As Long, x As Integer
Dim arr()
    Sheets(2).Columns(1).Clear
    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
        With CreateObject("Scripting.Dictionary")
            For i = 2 To il
                If Not .exists(Cells(i, x).Value) Then .Add Key:=Cells(i, x).Value, Item:=""
            Next i
       arr = Application.Transpose(.keys)
       End With
       Set r = Sheets(2).Cells(1).Resize(UBound(arr), 1)
            r.Value = arr
    Cells(2, 7).Validation.Delete
    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address
End Sub
[/vba]
К сообщению приложен файл: 1455731.xls(44.0 Kb)
 
Ответить
СообщениеВот вариант со словариком
[vba]
Код
Sub Список()
Dim il As Long, i As Long, x As Integer
Dim arr()
    Sheets(2).Columns(1).Clear
    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
        With CreateObject("Scripting.Dictionary")
            For i = 2 To il
                If Not .exists(Cells(i, x).Value) Then .Add Key:=Cells(i, x).Value, Item:=""
            Next i
       arr = Application.Transpose(.keys)
       End With
       Set r = Sheets(2).Cells(1).Resize(UBound(arr), 1)
            r.Value = arr
    Cells(2, 7).Validation.Delete
    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address
End Sub
[/vba]

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

2003
Сегодня явно не мой день... Опять ошибка[vba]
Код
Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address
[/vba]
 
Ответить
СообщениеСегодня явно не мой день... Опять ошибка[vba]
Код
Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="=" & Sheets(2).Name & "!" & r.Address
[/vba]

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

2013, 365
pechkin,
так попробуйте
[vba]
Код
    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="='" & Sheets(2).Name & "'!" & r.Address(, , Application.ReferenceStyle)
[/vba]




Сообщение отредактировал boa - Пятница, 08.06.2018, 15:37
 
Ответить
Сообщениеpechkin,
так попробуйте
[vba]
Код
    Cells(2, 7).Validation.Add Type:=xlValidateList, Formula1:="='" & Sheets(2).Name & "'!" & r.Address(, , Application.ReferenceStyle)
[/vba]

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

Excel 2010
[offtop]
Опять ошибка

установите себе версию посвежее, хотя бы 2007 :)
 
Ответить
Сообщение[offtop]
Опять ошибка

установите себе версию посвежее, хотя бы 2007 :)

Автор - sboy
Дата добавления - 08.06.2018 в 15:53
_Boroda_ Дата: Пятница, 08.06.2018, 22:53 | Сообщение № 26
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13187
Репутация: 5422 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Я бы сделал список на отдельном листе

Я бы тоже. И, поскольку в 2003 диапазон проверки нельзя делать на другой лист, то засунул бы его в именованный диапазон (Контрл F3)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "E2" Then Exit Sub
    Select Case Target.Value
        Case "Тема1"
            c_ = 1
        Case "Тема2"
            c_ = 2
        Case Else
            Exit Sub
    End Select
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To r1_
            If Not IsEmpty(ar(i, 1)) Then
                aaa = .Item(CStr(ar(i, 1)))
            End If
        Next i
        Sheets(2).Columns(1).ClearContents
        Sheets(2).Cells(1).Resize(.Count) = Application.Transpose(.Keys)
        ActiveWorkbook.Names.Add Name:="spis", RefersTo:="=Лист2!$A$1:$A$" & .Count
    End With
End Sub
[/vba]
К сообщению приложен файл: 3411890_1.xls(59.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Я бы сделал список на отдельном листе

Я бы тоже. И, поскольку в 2003 диапазон проверки нельзя делать на другой лист, то засунул бы его в именованный диапазон (Контрл F3)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "E2" Then Exit Sub
    Select Case Target.Value
        Case "Тема1"
            c_ = 1
        Case "Тема2"
            c_ = 2
        Case Else
            Exit Sub
    End Select
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To r1_
            If Not IsEmpty(ar(i, 1)) Then
                aaa = .Item(CStr(ar(i, 1)))
            End If
        Next i
        Sheets(2).Columns(1).ClearContents
        Sheets(2).Cells(1).Resize(.Count) = Application.Transpose(.Keys)
        ActiveWorkbook.Names.Add Name:="spis", RefersTo:="=Лист2!$A$1:$A$" & .Count
    End With
End Sub
[/vba]

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

2003
Здравствуйте! Большое спасибо всем откликнувшимся на тему! Макрос от Boroda подходит и все-же... Вопрос для меня решен не до конца, а именно возможно ли макросом в 2003-ем сделать выпадающий список чисел (в том числе дробных), чтобы при выборе из этого списка в ячейке получалось число а не текст? Пробовал разные манипуляции с форматами ячеек, преобразованием текста в числа - пока не получается желаемый результат...
Еще раз всем спасибо!


Сообщение отредактировал pechkin - Суббота, 09.06.2018, 08:15
 
Ответить
СообщениеЗдравствуйте! Большое спасибо всем откликнувшимся на тему! Макрос от Boroda подходит и все-же... Вопрос для меня решен не до конца, а именно возможно ли макросом в 2003-ем сделать выпадающий список чисел (в том числе дробных), чтобы при выборе из этого списка в ячейке получалось число а не текст? Пробовал разные манипуляции с форматами ячеек, преобразованием текста в числа - пока не получается желаемый результат...
Еще раз всем спасибо!

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

2013, 365
pechkin, млжно сменить региональные настройки(точку на заптую), но это не выход <_<


 
Ответить
Сообщениеpechkin, млжно сменить региональные настройки(точку на заптую), но это не выход <_<

Автор - boa
Дата добавления - 09.06.2018 в 20:12
RAN Дата: Воскресенье, 10.06.2018, 10:18 | Сообщение № 29
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4849
Репутация: 971 ±
Замечаний: 0% ±

2010
возможно ли макросом......чтобы при выборе из этого списка в ячейке получалось число

Да, возможно. Для этого в качестве источника данных следует указывать диапазон листа.
Но Ваш вопрос, насколько я понял, заключается в том, возможно ли в свойство Validation.Formula1 записать массив, содержащий число с разделителем запятая.
Это свойство не поддерживает региональные локали, и в этом массиве может быть записано только число с разделителем точка. А при попытке вставить это число из списка на лист, Excel перехватывает управление, и превращает число в дату (если может).
Измените в своем макросе строку, и проследите результат.
[vba]
Код
uniq.Add Replace(Cells(i, x), ",", "."), CStr(Cells(i, x))
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
возможно ли макросом......чтобы при выборе из этого списка в ячейке получалось число

Да, возможно. Для этого в качестве источника данных следует указывать диапазон листа.
Но Ваш вопрос, насколько я понял, заключается в том, возможно ли в свойство Validation.Formula1 записать массив, содержащий число с разделителем запятая.
Это свойство не поддерживает региональные локали, и в этом массиве может быть записано только число с разделителем точка. А при попытке вставить это число из списка на лист, Excel перехватывает управление, и превращает число в дату (если может).
Измените в своем макросе строку, и проследите результат.
[vba]
Код
uniq.Add Replace(Cells(i, x), ",", "."), CStr(Cells(i, x))
[/vba]

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

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