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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос ячек с одного листа EXCEL на другой по условию... - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос ячек с одного листа EXCEL на другой по условию... (Word)
Перенос ячек с одного листа EXCEL на другой по условию...
Jawa_12 Дата: Среда, 17.03.2021, 12:54 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Здравствуйте, господа!
Прошу помощи...
Имеем: файл, с тремя листами: "Перечень оборудования и ОС", "Нормативы ОР", "Legends".
Работать нужно в "Норсативы ОР". Оборудование из первого листа переносим вручную в "Нормативы ОР"
Хотелось бы:
помочь в составлении макроса который бы при запуске(только в ячейке столбца №6):
-проверял содержимое ячейки столбца"Наименование техкарты" листа "Нормативы ОР", и считал строки с таким же содержимым в столбце "Наименование техкарты" листа"Legends";
-копировал ячейки этих строк с 6("Наименование техкарты") по 23("Время,мин") на лист "Нормативы ОР" при этом ячейки со 2й по 5ю заполнялись значениями исходной строки;
- в первой строке оставить формулу
- и помечать строки отметкой "макрос" в 25 столбце(это уже получилось...)

На форуме уже нашёл макрос что копирует строку,
[vba]
Код
Код:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  If Target.Column <> 6 Then Exit Sub
  Cancel = True: r = Target.Row + 1: Rows(r).Insert Shift:=xlDown
  Target.EntireRow.Copy: Cells(r, 1).PasteSpecial Paste:=xlPasteValues:  Cells(r, 24) = "Макрос":
  Cells(r, 6).Select
End Sub
[/vba]

но как прикрутить к нему индекс(поискпоз()) знаний не хватает. Да, и... нужен другой макрос чтоб срабатывал по горячим клавишам(но это я уже освоил)
Помогите люди добрые!!!
PS почему здесь нельзя вложить файл с макросами???
К сообщению приложен файл: __.v3.xls(471.5 Kb)


Сообщение отредактировал Serge_007 - Среда, 17.03.2021, 13:44
 
Ответить
СообщениеЗдравствуйте, господа!
Прошу помощи...
Имеем: файл, с тремя листами: "Перечень оборудования и ОС", "Нормативы ОР", "Legends".
Работать нужно в "Норсативы ОР". Оборудование из первого листа переносим вручную в "Нормативы ОР"
Хотелось бы:
помочь в составлении макроса который бы при запуске(только в ячейке столбца №6):
-проверял содержимое ячейки столбца"Наименование техкарты" листа "Нормативы ОР", и считал строки с таким же содержимым в столбце "Наименование техкарты" листа"Legends";
-копировал ячейки этих строк с 6("Наименование техкарты") по 23("Время,мин") на лист "Нормативы ОР" при этом ячейки со 2й по 5ю заполнялись значениями исходной строки;
- в первой строке оставить формулу
- и помечать строки отметкой "макрос" в 25 столбце(это уже получилось...)

На форуме уже нашёл макрос что копирует строку,
[vba]
Код
Код:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  If Target.Column <> 6 Then Exit Sub
  Cancel = True: r = Target.Row + 1: Rows(r).Insert Shift:=xlDown
  Target.EntireRow.Copy: Cells(r, 1).PasteSpecial Paste:=xlPasteValues:  Cells(r, 24) = "Макрос":
  Cells(r, 6).Select
End Sub
[/vba]

но как прикрутить к нему индекс(поискпоз()) знаний не хватает. Да, и... нужен другой макрос чтоб срабатывал по горячим клавишам(но это я уже освоил)
Помогите люди добрые!!!
PS почему здесь нельзя вложить файл с макросами???

Автор - Jawa_12
Дата добавления - 17.03.2021 в 12:54
Serge_007 Дата: Среда, 17.03.2021, 13:46 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 13873
Репутация: 2315 ±
Замечаний: ±

Excel 2010
почему здесь нельзя вложить файл с макросами?
Можно
Почему возник такой вопрос?


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
почему здесь нельзя вложить файл с макросами?
Можно
Почему возник такой вопрос?

Автор - Serge_007
Дата добавления - 17.03.2021 в 13:46
Jawa_12 Дата: Среда, 17.03.2021, 15:49 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Почему возник такой вопрос?

потому что не даёт вложить ничего кроме .xml (еxcel2003) файл не более 500кБ... даже архив не пропускает...
 
Ответить
Сообщение
Почему возник такой вопрос?

потому что не даёт вложить ничего кроме .xml (еxcel2003) файл не более 500кБ... даже архив не пропускает...

Автор - Jawa_12
Дата добавления - 17.03.2021 в 15:49
Serge_007 Дата: Среда, 17.03.2021, 16:12 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 13873
Репутация: 2315 ±
Замечаний: ±

Excel 2010
не даёт вложить ничего кроме .xml
XML - это немного другое :)
Прикладывать можно файлы любых форматов, ограничений на форматы на форуме нет (см. вложение)
А вот на размер файла - есть
К сообщению приложен файл: 20210317_Jawa_1.xlsm(7.6 Kb)


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
не даёт вложить ничего кроме .xml
XML - это немного другое :)
Прикладывать можно файлы любых форматов, ограничений на форматы на форуме нет (см. вложение)
А вот на размер файла - есть

Автор - Serge_007
Дата добавления - 17.03.2021 в 16:12
Jawa_12 Дата: Вторник, 30.03.2021, 08:32 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Ну помогите, люди добрые!
Не получается разобраться с этими "обьектами, свойствами, свойствами которые бывают обьектами"... А начальство прессует чтоб был результат... а вручную обрабатывать 96000строк - повеситься можно...
Вот попытался собрать макрос, но знаний не хватает допилить...
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Long
  If Target.Column <> 6 Then Exit Sub
  Cancel = True:
  Set c = Worksheets(4).Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
        r = Target.Row + 1: Rows(r).Insert Shift:=xlDown
        Intersect(Worksheets(4).Rows(c.Row), Worksheets(4).Range("F:W")).Copy Destination:=Worksheets(2).Range("F" & "W")  'ïûòàåìñÿ êîïèðîâàòü ïåðåñå÷åíèå ñòðîêè è äèàïàçîíà ëèñòà 4 íà ëèñò 2
       Set c = Worksheets(4).Range("F:F").FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End Sub
[/vba]
ещё раз напомню что макрос должен делать:
-проверял содержимое ячейки столбца"Наименование техкарты" листа "Нормативы ОР", и считал строки с таким же содержимым в столбце "Наименование техкарты" листа"Legends";
-копировал ячейки этих строк с 6("Наименование техкарты") по 23("Время,мин") на лист "Нормативы ОР" при этом ячейки со 2й по 5ю заполнялись значениями исходной строки;
- в первой строке оставить формулу...

помогите пожалуйста! ибо вручную это забивать - равносильно самоубийству(хотя другие сидят и тычут Ctrl+C, Ctrl+V)
PS приложенный файл очень сильно урезан в плане данных...
К сообщению приложен файл: __.v1.5.xlsb(497.8 Kb)
 
Ответить
СообщениеНу помогите, люди добрые!
Не получается разобраться с этими "обьектами, свойствами, свойствами которые бывают обьектами"... А начальство прессует чтоб был результат... а вручную обрабатывать 96000строк - повеситься можно...
Вот попытался собрать макрос, но знаний не хватает допилить...
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Long
  If Target.Column <> 6 Then Exit Sub
  Cancel = True:
  Set c = Worksheets(4).Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then
    firstResult = c.Address
    Do
        r = Target.Row + 1: Rows(r).Insert Shift:=xlDown
        Intersect(Worksheets(4).Rows(c.Row), Worksheets(4).Range("F:W")).Copy Destination:=Worksheets(2).Range("F" & "W")  'ïûòàåìñÿ êîïèðîâàòü ïåðåñå÷åíèå ñòðîêè è äèàïàçîíà ëèñòà 4 íà ëèñò 2
       Set c = Worksheets(4).Range("F:F").FindNext(c)
      If c Is Nothing Then Exit Do
    Loop While c.Address <> firstResult
  End If
End Sub
[/vba]
ещё раз напомню что макрос должен делать:
-проверял содержимое ячейки столбца"Наименование техкарты" листа "Нормативы ОР", и считал строки с таким же содержимым в столбце "Наименование техкарты" листа"Legends";
-копировал ячейки этих строк с 6("Наименование техкарты") по 23("Время,мин") на лист "Нормативы ОР" при этом ячейки со 2й по 5ю заполнялись значениями исходной строки;
- в первой строке оставить формулу...

помогите пожалуйста! ибо вручную это забивать - равносильно самоубийству(хотя другие сидят и тычут Ctrl+C, Ctrl+V)
PS приложенный файл очень сильно урезан в плане данных...

Автор - Jawa_12
Дата добавления - 30.03.2021 в 08:32
Kuzmich Дата: Вторник, 30.03.2021, 11:05 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 589
Репутация: 126 ±
Замечаний: 0% ±

Excel 2003
Пробуйте
[vba]
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Range              ' х.з. какое значение
  Dim firstResult As String
  Dim Legends As Worksheet
  If Target.Column <> 6 Then Exit Sub   'если тыкаем не в 6й столбец - выходим
Set Legends = ThisWorkbook.Worksheets("Legends")
Set c = Legends.Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then                  ' если "с"  найдено...
    firstResult = c.Address
    Do
        Rows(Target.Row + 1).Insert Shift:=xlDown
        Legends.Range("F" & c.Row & ":W" & c.Row).Copy Range("F" & Target.Row + 1)  'пытаемся копировать пересечение строки и диапазона листа 4 на лист 2
          'надо ещё воткнуть копирование ячеек листа "Нормативы ОР" с 1й по 5ю... ???
        Range("A" & Target.Row & ":E" & Target.Row).Copy Range("A" & Target.Row + 1)
      Set c = Legends.Range("F:F").FindNext(c)
    Loop While c.Address <> firstResult
  End If
End Sub
[/vba]
 
Ответить
СообщениеПробуйте
[vba]
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim r As Long
  Dim c As Range              ' х.з. какое значение
  Dim firstResult As String
  Dim Legends As Worksheet
  If Target.Column <> 6 Then Exit Sub   'если тыкаем не в 6й столбец - выходим
Set Legends = ThisWorkbook.Worksheets("Legends")
Set c = Legends.Range("F:F").Find(Target, LookIn:=xlValues)
  If Not c Is Nothing Then                  ' если "с"  найдено...
    firstResult = c.Address
    Do
        Rows(Target.Row + 1).Insert Shift:=xlDown
        Legends.Range("F" & c.Row & ":W" & c.Row).Copy Range("F" & Target.Row + 1)  'пытаемся копировать пересечение строки и диапазона листа 4 на лист 2
          'надо ещё воткнуть копирование ячеек листа "Нормативы ОР" с 1й по 5ю... ???
        Range("A" & Target.Row & ":E" & Target.Row).Copy Range("A" & Target.Row + 1)
      Set c = Legends.Range("F:F").FindNext(c)
    Loop While c.Address <> firstResult
  End If
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 30.03.2021 в 11:05
Jawa_12 Дата: Среда, 31.03.2021, 09:08 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

ок спасибо... только получается перенесённые строки начинаются с последней... т.е. не учёл, что строки вставляются сверху... теперь надо либо поиск делать снизу вверх, либо вставлять строку ниже скопированной... и еще... почему то в "целевой"строке(в которой был щелчёк) не копируются ячейки F:W...
Огромное СПАСИБО!!!
 
Ответить
Сообщениеок спасибо... только получается перенесённые строки начинаются с последней... т.е. не учёл, что строки вставляются сверху... теперь надо либо поиск делать снизу вверх, либо вставлять строку ниже скопированной... и еще... почему то в "целевой"строке(в которой был щелчёк) не копируются ячейки F:W...
Огромное СПАСИБО!!!

Автор - Jawa_12
Дата добавления - 31.03.2021 в 09:08
Kuzmich Дата: Среда, 31.03.2021, 09:58 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 589
Репутация: 126 ±
Замечаний: 0% ±

Excel 2003
Цитата
только получается перенесённые строки начинаются с последней

Используйте метод Find с параметром
[vba]
Код
Set c = Legends.Range("F:F").Find(Target, , xlValues, xlWhole, , xlPrevious)
[/vba]
Цитата
в "целевой"строке(в которой был щелчёк) не копируются ячейки F:W...

По вашей логике и не должно туда ничего копироваться.
 
Ответить
Сообщение
Цитата
только получается перенесённые строки начинаются с последней

Используйте метод Find с параметром
[vba]
Код
Set c = Legends.Range("F:F").Find(Target, , xlValues, xlWhole, , xlPrevious)
[/vba]
Цитата
в "целевой"строке(в которой был щелчёк) не копируются ячейки F:W...

По вашей логике и не должно туда ничего копироваться.

Автор - Kuzmich
Дата добавления - 31.03.2021 в 09:58
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос ячек с одного листа EXCEL на другой по условию... (Word)
  • Страница 1 из 1
  • 1
Поиск:

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