Перейти до основного матеріалу

Як продублювати рядки на основі значення комірки в стовпці?

Автор: Сяоян Остання зміна: 2023-05-04

Наприклад, у мене є діапазон даних, який містить перелік чисел у стовпці D, і тепер я хочу кілька разів продублювати цілі рядки на основі числових значень у стовпці D, щоб отримати такий результат. Як я можу скопіювати рядки кілька разів на основі значень комірок у Excel?

Дублюйте рядки кілька разів на основі значень комірок за допомогою коду VBA

Копіюйте та вставляйте рядки на основі вказаної кількості разів за допомогою зручного інструменту - Kutools для Excel


Дублюйте рядки кілька разів на основі значень комірок за допомогою коду VBA

Щоб скопіювати та продублювати цілі рядки кілька разів на основі значень комірок, вам може допомогти наступний код VBA, зробіть так:

1. Утримуйте клавішу ALT + F11 ключі, щоб відкрити Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Модулі Вікно

Код VBA: Дублюйте рядки кілька разів на основі значення комірки:

Sub CopyData()
'Updateby Extendoffice
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "D")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

3. Потім натисніть F5 ключ для запуску цього коду, цілі рядки дублювались кілька разів на основі значення комірки в стовпці D, як вам потрібно.

примітки: У наведеному вище коді буква A вказує початковий стовпець вашого діапазону даних і літеру D - буква стовпця, на основі якої потрібно дублювати рядки. Будь ласка, змініть їх на свої потреби.

Копіюйте та вставляйте рядки на основі вказаної кількості разів за допомогою зручного інструменту - Kutools для Excel

Якщо ви не знайомі з кодом VBA і не можете правильно змінити параметри в коді самостійно. У цьому випадку Kutools для Excel's Повторювані рядки/стовпці на основі значення клітинки Функція може допомогти вам копіювати та вставляти рядки кілька разів на основі значень клітинок лише трьома клацаннями.

Tips : Застосувати це Повторювані рядки / стовпці на основі значення комірки функція, ви повинні завантажити Kutools для Excel перший.
  1. Натисніть Кутулс > Insert > Повторювані рядки/стовпці на основі значення комірки щоб увімкнути цю функцію;
  2. Потім виберіть Скопіюйте та вставте рядки і вкажіть клітинки Вставити діапазон та Час повторення окремо в діалоговому вікні.

Найкращі інструменти продуктивності офісу

🤖 Kutools AI Aide: Революціонізуйте аналіз даних на основі: Інтелектуальне виконання   |  Згенерувати код  |  Створення спеціальних формул  |  Аналізуйте дані та створюйте діаграми  |  Викликати функції Kutools...
Популярні функції: Знайдіть, виділіть або визначте дублікати   |  Видалити порожні рядки   |  Об’єднайте стовпці або клітинки без втрати даних   |   Раунд без Формули ...
Супер пошук: VLookup за кількома критеріями    Багатозначний VLookup  |   VLookup на кількох аркушах   |   Нечіткий пошук ....
Розширений розкривний список: Швидке створення випадаючого списку   |  Залежний спадний список   |  Виберіть розкривний список, що вибирається ....
Менеджер колонок: Додайте конкретну кількість стовпців  |  Перемістити стовпці  |  Перемкнути статус видимості прихованих стовпців  |  Порівняйте діапазони та стовпці ...
Особливості: Фокус сітки   |  Перегляд дизайну   |   Велика панель формул    Диспетчер робочих книг і аркушів   |  Бібліотека ресурсів (автотекст)   |  Вибір дати   |  Об’єднайте робочі аркуші   |  Шифрування/розшифрування клітинок    Надсилайте листи за списком   |  Супер фільтр   |   Спеціальний фільтр (фільтр жирний/курсив/закреслений...) ...
Топ-15 наборів інструментів12 текст Tools (додати текст, Видалити символи, ...)   |   50 + Графік типи (діаграма Ганта, ...)   |   40+ Практичний Формули (Розрахуйте вік на основі дня народження, ...)   |   19 вставка Tools (Вставте QR-код, Вставити зображення зі шляху, ...)   |   12 Перетворення Tools (Числа до слів, Валютна конверсія, ...)   |   7 Злиття та розділення Tools (Розширені комбіновані ряди, Розділені клітини, ...)   |   ... і більше

Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу.  Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...

Опис


Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
Comments (43)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
the formula worked when the data set in a column has no blank row. however, it won't work if there is a blank row separating the rows with data. is there any script to add to work it just like that?
This comment was minimized by the moderator on the site
Hello, Charies,
Yes, as you said, the code will not work if there are blank rows in the data range. To solve this issue, please apply the below modified code:
Sub CopyData()
    ' Update by Extendoffice
    Dim xRow As Long
    Dim VInSertNum As Variant
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    ' Find the last row with data in column A
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    xRow = 1
    Do While xRow <= LastRow
        ' Check if there is data in column A of the current row
        If Cells(xRow, "A") <> "" Then
            VInSertNum = Cells(xRow, "D")
            If IsNumeric(VInSertNum) And VInSertNum > 1 Then
                Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
                Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
                Selection.Insert Shift:=xlDown
                ' Update LastRow due to insertion
                LastRow = LastRow + VInSertNum - 1
                xRow = xRow + VInSertNum - 1 ' Move xRow to the row after the last inserted
            End If
        End If
        xRow = xRow + 1
    Loop

    Application.ScreenUpdating = True
End Sub



Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Hi All,
Can anyone give me the code to copy whole table at the same time?.
This comment was minimized by the moderator on the site
Hello, Aparna,
Maybe the following article can help you.
https://www.extendoffice.com/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html#a2
Please view it, if you have any other problem, please comment here.
This comment was minimized by the moderator on the site
Is there any way to get this to work on a shared workbook? it works perfectly until I share the workbook then i get "insert method of range class failed"
This comment was minimized by the moderator on the site
Bonjour,
Merci pour ce code qui fonctionne bien.
Par contre dans mon tableau j'ai une date pour chaque ligne:
J'aimerai qu'elle s'incrémente au fur et à mesure des duplications de lignes et en automatique, car il y a plus de 1000 dossiers différents.

N° dossier Date Nb de jours
2101007 29/01/2021 49
2110002 11/10/2021 22
2008006 31/08/2020 132

pour donner:
N° dossier Date Nb de jours
2101007 29/01/2021 49
2101007 30/01/2021 49
...

Est-ce possible ?
Merci par avance.
This comment was minimized by the moderator on the site
Thank you so much for this!
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations