Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
rustiksab
0 / 0 / 0
Регистрация: 29.11.2018
Сообщений: 7
1
Excel

Скопировать строку Excel, за текущей строкой если из выпадающего списка выбрать второе значение в ячейке

05.12.2018, 14:40. Просмотров 522. Ответов 2
Метки нет (Все метки)

Добрый день, никак не получается совместить макрос который я пытаюсь совместить
Есть макрос который выполняется если выбрать из списка ячейки D, новое значение
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
On Error Resume Next
    If Not Intersect(Target, Range("D2:D300")) Is Nothing And Target.Cells.Count = 1 Then
            
        Rows(Target.Row + 1).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
       Cells(Target.Row, 1).Resize(1, 14).Copy
       Cells(Target.Row + 1, 1).Resize(1, 14).PasteSpecial Paste:=xlPasteValues
       
End If
     Application.CutCopyMode = False
            
        Application.EnableEvents = True
   
End Sub
Он выполняется, вставляет новую строку снизу, но
У меня задача немного поставлена по другому, оставлять в строке где выбрал старое значение, а копировать уже с новым.
Примерно такое реализовано в этом скрипте
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
Помогите совместить эти два скрипта.
Для дополнительной наглядности прилагаю файл, где описал что должно произойти
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
05.12.2018, 14:40
Ответы с готовыми решениями:

Создание выпадающего списка в ячейке Excel
Всем здравствуйте!!! Я формирую электронные учебные журналы в виде excel файла для одного учебного...

Программно выбрать значение выпадающего списка
Есть выпадающий список в форме Поле &quot;код&quot; скрыто Но мне известен и код и строка Хочу програмно...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
rustiksab
0 / 0 / 0
Регистрация: 29.11.2018
Сообщений: 7
05.12.2018, 14:42  [ТС] 2
Файл примера
0
Вложения
Тип файла: xlsx Книга1.xlsx (8.3 Кб, 2 просмотров)
rustiksab
0 / 0 / 0
Регистрация: 29.11.2018
Сообщений: 7
06.12.2018, 11:11  [ТС] 3
Разобрался сам.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Worksheet_Change(ByVal Target As Range)
     Application.EnableEvents = True
         If Not Intersect(Target, Range("D2:D10")) 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
               Rows(Target.Row + 1).Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(Target.Row, 1).Resize(1, 14).Copy
            Cells(Target.Row + 1, 1).Resize(1, 14).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
            Cells(Target.Row, "D").Value = oldval
             Cells(Target.Row + 1, "D").Value = newVal
        Else
            Target = newVal
        End If
        If Len(newVal) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
0
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.