Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.71/7: Рейтинг темы: голосов - 7, средняя оценка - 4.71
2 / 2 / 0
Регистрация: 08.04.2016
Сообщений: 78
Excel

Найти все строки с необходимой маркировковкой и скопировать строки и их коды в другую таблицу

30.12.2021, 15:48. Показов 1316. Ответов 4

Студворк — интернет-сервис помощи студентам
Помогите создать макрос VBA.
Найти строки с FO_cabel в таб. на Листе1 и скопировать в таб. на Лист2 в том же порядке.
Файл с примером приложен.
Вложения
Тип файла: rar Вопрос_VB_excel.rar (9.9 Кб, 33 просмотров)
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
30.12.2021, 15:48
Ответы с готовыми решениями:

Скопировать все строки из определенных полей одной таблицы в другую таблицу
Имеются 2 таблицы: ADOTable1 ADOTable6 Нужно скопировать все строки из полей AAA, BBB, CCC таблицы ADOTable1 в таблицу ADOTable6. ...

Скопировать все цифры из одной строки в другую
Задание: Программа получает в качестве параметра адрес sz-строки и копирует только цифры из него в другую строку. Количество...

Из одной строки скопировать в другую все слова которые начинаются с цифры
Суть задачи: из одной строки скопировать в другую все слова которые начинаются с цифры. (слова - наборы символов разделённые пробелом) и...

4
349 / 190 / 108
Регистрация: 01.04.2020
Сообщений: 537
30.12.2021, 20:47
Лучший ответ Сообщение было отмечено blackcat1024 как решение

Решение

Цитата Сообщение от blackcat1024 Посмотреть сообщение
Найти строки с FO_cabel в таб. на Листе1 и скопировать в таб. на Лист2 в том же порядке.
если копировать только данные, то можно так
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub CopyData()
Dim RwL1&, RwL2&, Rw&
Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = Sheets(1)     'или: Sheets("Лист1")
    Set Sh2 = Sheets(2)     'или: Sheets("Лист2")
    RwL1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
    RwL2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
    For Rw = 8 To RwL1
        If Sh1.Cells(Rw, 4) = "FO_cabel" Then
            RwL2 = RwL2 + 1
            Sh2.Cells(RwL2, 1) = Sh1.Cells(Rw, 1)
            Sh2.Cells(RwL2, 2) = Sh1.Cells(Rw, 2)
            Sh2.Cells(RwL2, 3) = Sh1.Cells(Rw, 3)
            Sh2.Cells(RwL2, 4) = Sh1.Cells(Rw, 4)
            Sh2.Cells(RwL2, 5) = Sh1.Cells(Rw, 8)
            Sh2.Cells(RwL2, 6) = Sh1.Cells(Rw, 16)
        End If
    Next
End Sub
1
2 / 2 / 0
Регистрация: 08.04.2016
Сообщений: 78
31.12.2021, 15:54  [ТС]
Спасибо elixi за ответ. Все работает. Копирует все FO_cabel на Лист2 и все другие столбцы. В файле был еще первый пункт, связанный с поиском moD и копированием числа слева от него из столбца (Num) в 13-й столбец (Block) на той же строке Листе1. Пожалуйста, дополните код.
0
Одесса - Украина
 Аватар для MikeVol
517 / 196 / 69
Регистрация: 01.04.2020
Сообщений: 610
31.12.2021, 17:23
Лучший ответ Сообщение было отмечено blackcat1024 как решение

Решение

blackcat1024, С Наступающим Новым Годом! Думаю elixi, не будет против за то что дополню его код.
Кликните здесь для просмотра всего текста
Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub CopyData()
    Dim RwL1&, RwL2&, Rw&
    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = Sheets(1)     'или: Sheets("Лист1")
    Set Sh2 = Sheets(2)     'или: Sheets("Лист2")
    RwL1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
    RwL2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
 
    For Rw = 8 To RwL1
 
        If Sh1.Cells(Rw, 4) = "FO_cabel" Then
            RwL2 = RwL2 + 1
            Sh2.Cells(RwL2, 1) = Sh1.Cells(Rw, 1)
            Sh2.Cells(RwL2, 2) = Sh1.Cells(Rw, 2)
            Sh2.Cells(RwL2, 3) = Sh1.Cells(Rw, 3)
            Sh2.Cells(RwL2, 4) = Sh1.Cells(Rw, 4)
            Sh2.Cells(RwL2, 5) = Sh1.Cells(Rw, 8)
            Sh2.Cells(RwL2, 6) = Sh1.Cells(Rw, 16)
        End If
 
        If Sh1.Cells(Rw, 4) = "moD" Then
            Sh1.Cells(Rw, 13).Clear
            Sh1.Cells(Rw, 13) = Sh1.Cells(Rw, 3)
 
            With Sh1.Cells(Rw, 13)
                .NumberFormat = "0"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
 
        End If
 
    Next
 
End Sub

Здоровья!
1
2 / 2 / 0
Регистрация: 08.04.2016
Сообщений: 78
31.12.2021, 19:34  [ТС]
Ребята elixi и MikeVol с Наступающим вас 2022 Годом!
Желаю в предстоящем году новых успехов и достижений, новых идей, новых возможностей, новых горизонтов вдохновения!
Спасибо вам за помощь. Удачи.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
31.12.2021, 19:34
Помогаю со студенческими работами здесь

Как автоматически скопировать данные одной ячейки первой строки в другую ячейку 2 строки
Здравствуйте!!! Дана таблица, или запрос Код |дата |Всего товара на складе |Приход товара от поставщика |Итого на складе...

Скопировать строку в другую строку заданной длины и разместить текст первой строки по центру второй строки
Добрый день! Друзья, помогите, пожалуйста, с лабораторными по С. Учусь на физика, в программировании вообще ничего не понимаю, а без этих...

Скопировать строку в другую строку заданной длины и размещает текст первой строки по центру другой строки
Функция копирует строку в другую строку заданной длины и размещает текст первой строки по центру другой строки. Так звучит задание. Все...

Скопировать из файла F1 в файл F2 все строки, кроме строки, содержащей короткое слово
Текстовий файл F1 має містити не менше 10 рядків Задание: Скопировать из файла F1 в файл F2 все строки , кроме строки , содержащий...

Скопировать из файла F1 в файл F2 все строки, кроме той строки, в которой больше всего гласных букв
1) Скопировать из файла F1 в файл F2 все строки, кроме той строки, в которой больше всего гласных букв. 2) Напечатать номер этой...


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

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Новые блоги и статьи
Музыка, написанная Искусственным Интеллектом
volvo 04.12.2025
Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .
От async/await к виртуальным потокам в Python
IndentationError 23.11.2025
Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов
Argus19 22.11.2025
Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином.
Programma_Boinc 20.11.2025
Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha
Etyuhibosecyu 20.11.2025
Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .
Мысли в слух
kumehtar 18.11.2025
Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .
Создание Single Page Application на фреймах
krapotkin 16.11.2025
Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .
Фото: Daniel Greenwood
kumehtar 13.11.2025
Расскажи мне о Мире, бродяга
kumehtar 12.11.2025
— Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .
PowerShell Snippets
iNNOKENTIY21 11.11.2025
Модуль PowerShell 5. 1+ : Snippets. psm1 У меня модуль расположен в пользовательской папке модулей, по умолчанию: \Documents\WindowsPowerShell\Modules\Snippets\ А в самом низу файла-профиля. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru