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

Вход

Регистрация

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

 

= Мир MS Excel/как сделать выпадающий список с накоплением в этой же ячейке - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
как сделать выпадающий список с накоплением в этой же ячейке
saty Дата: Понедельник, 13.01.2014, 13:46 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Прошу помочь с вопросом, есть тело макроса...но макрос не хочет работать.. в чем ошибка?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldVal) <> 0 And oldVal <> newVal Then
Target = Target & "," & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub
[/vba]
[moder]В том, что Правила форума не читаете
Файл где?
И почему код без соответствующих тегов был (кнопка #)?
 
Ответить
СообщениеПрошу помочь с вопросом, есть тело макроса...но макрос не хочет работать.. в чем ошибка?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldVal) <> 0 And oldVal <> newVal Then
Target = Target & "," & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub
[/vba]
[moder]В том, что Правила форума не читаете
Файл где?
И почему код без соответствующих тегов был (кнопка #)?

Автор - saty
Дата добавления - 13.01.2014 в 13:46
Jhonson Дата: Понедельник, 13.01.2014, 15:14 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 514
Репутация: 169 ±
Замечаний: 0% ±

Так вроде работает:[vba]
Код
Option Explicit
Public oldVal As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
     oldVal = Target.Value
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
Application.EnableEvents = False
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
     newVal = Target.Value
         If newVal <> "" Then
             If InStr(1, oldVal, newVal) = 0 Then
                 If oldVal = "" Then
                     Target = newVal
                 Else
                     Target = oldVal & "," & newVal
                 End If
                 oldVal = Target.Value
             Else
                 Target = oldVal
             End If
         End If
End If
Application.EnableEvents = True
End Sub
[/vba]
К сообщению приложен файл: saty.xls (26.5 Kb)


"Ничто не приносит людям столько неприятностей, как разум."
 
Ответить
СообщениеТак вроде работает:[vba]
Код
Option Explicit
Public oldVal As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
     oldVal = Target.Value
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
Application.EnableEvents = False
If Not Intersect(Target, Range("C2:C5")) Is Nothing And Target.Cells.Count = 1 Then
     newVal = Target.Value
         If newVal <> "" Then
             If InStr(1, oldVal, newVal) = 0 Then
                 If oldVal = "" Then
                     Target = newVal
                 Else
                     Target = oldVal & "," & newVal
                 End If
                 oldVal = Target.Value
             Else
                 Target = oldVal
             End If
         End If
End If
Application.EnableEvents = True
End Sub
[/vba]

Автор - Jhonson
Дата добавления - 13.01.2014 в 15:14
saty Дата: Понедельник, 13.01.2014, 15:52 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Jhonson, у меня видимо очень большая таблица... и расширение xlsm
 
Ответить
СообщениеJhonson, у меня видимо очень большая таблица... и расширение xlsm

Автор - saty
Дата добавления - 13.01.2014 в 15:52
  • Страница 1 из 1
  • 1
Поиск:

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