Прескочи на основното съдържание

Как да дублирам редове въз основа на стойността на клетка в колона?

Автор: Xiaoyang Последна промяна: 2023-05-04

Например, имам диапазон от данни, който съдържа списък с числа в колона D, и сега искам да дублирам целите редове няколко пъти въз основа на числовите стойности в колона D, за да получа следния резултат. Как мога да копирам редовете няколко пъти въз основа на стойностите на клетките в Excel?

Дублирайте редове няколко пъти въз основа на стойностите на клетките с VBA код

Копирайте и вмъкнете редове въз основа на определен брой пъти с удобен инструмент - Kutools за Excel


Дублирайте редове няколко пъти въз основа на стойностите на клетките с VBA код

За да копирате и дублирате целите редове няколко пъти въз основа на стойностите на клетките, следният VBA код може да ви помогне, моля, направете следното:

1. Задръжте натиснат ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

2. Щракнете Поставете > Модулии поставете следния код в Модули Window.

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 Дублиране на редове/колони въз основа на стойността на клетката може да ви помогне да копирате и вмъквате редове няколко пъти въз основа на стойностите на клетките само с три кликвания.

Съвети: За да приложите това Дублиране на редове / колони въз основа на стойността на клетката функция, трябва изтеглете Kutools за Excel на първо място.
  1. Кликнете Kutools > Поставете > Дублиране на редове/колони въз основа на стойността на клетката за да активирате тази функция;
  2. След това изберете Копирайте и вмъкнете редове опция и посочете клетките на Вмъкване на диапазон намлява Повторете пъти отделно в диалоговия прозорец.

Най-добрите инструменти за продуктивност в офиса

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

Усъвършенствайте уменията си за 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!
This comment was minimized by the moderator on the site
What if I wanted to do the above (nice job btw) but what if I wanted to change the dates by “X” days when I add the rows? Like a reoccurring event in a calendar. 
This comment was minimized by the moderator on the site
This is PERFECTION! Short Sweet and to the point as well as easily adaptable!
THANK YOU!
This comment was minimized by the moderator on the site

this is wondeful thank you so much
This comment was minimized by the moderator on the site
I tried running it by pressing F5 and a pop up message below:
"Compile Error:Sub or function not defined."
What am I doing wrong? I adjusted column A and changed A & D as needed.
This comment was minimized by the moderator on the site
Hi, this does not work for me. I copy the code, change the column letter D to the column letter that I want to duplicate rows based upon, and... nothing happens when I run the code. I have enabled macros and tried on two different computers. What am I doing wrong?
This comment was minimized by the moderator on the site
Hi, Sean,
Note: In the above code, the letter A indicates the start column of your data range, and the letter D is the column letter that you want to duplicate the rows based on. Please change them to your need.
Have you adjust the column A of your data? please check it, thank you!

There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations