Ábending: Önnur tungumál eru Google-þýdd. Þú getur heimsótt English útgáfa af þessum tengil.
Skrá inn
x
or
x
x
Nýskráning
x

or

Hvernig á að afrita raðir byggðar á gildum í dálki?

Til dæmis, ég er með fjölda gagna sem inniheldur lista yfir tölur í dálki D og nú vil ég afrita alla línurnar nokkrum sinnum miðað við tölugildin í dálki D til að fá eftirfarandi niðurstöðu. Hvernig gat ég afritað raðirnar oft á grundvelli frumgilda í Excel?

doc endurtekning raðir með klefi 1

Afritaðu raðir mörgum sinnum á grundvelli gilda í klefi með VBA kóða


ör blár hægri kúla Afritaðu raðir mörgum sinnum á grundvelli gilda í klefi með VBA kóða

Til að afrita og afrita alla raðirnar oft á grundvelli frumgildanna getur eftirfarandi VBA kóða hjálpað þér, vinsamlegast gerðu eftirfarandi:

1. Haltu niður ALT + F11 lyklar til að opna Microsoft Visual Basic fyrir forrit gluggi.

2. Smelltu Setja > Mát, og líma eftirfarandi kóða í Mát Gluggi.

VBA kóða: Afritaðu raðir mörgum sinnum á grundvelli frumgildis:

Sub CopyData()
'Updateby Extendoffice 20160922
    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. Ýttu síðan á F5 lykillinn að því að keyra þennan kóða, hafa allar línurnar verið endurteknar margar sinnum miðað við gildið í dálki D eins og þú þarft.

Athugaðu: Í ofangreindum kóða, stafurinn A gefur til kynna byrjunar dálk gagnasviðsins og bréfið D er dálkurinn sem þú vilt afrita raðirnar byggðar á. Vinsamlegast breyttu þeim eftir þörfum þínum.



Ráðlögð framleiðni verkfæri

Office flipi

gull star1 Komdu með handan flipa í Excel og önnur Office hugbúnaður, eins og Króm, Firefox og nýjan Internet Explorer.

Kutools fyrir Excel

gull star1 Ótrúlegt! Auka framleiðni þína á 5 mínútum. Ekki þörf á sérstökum hæfileikum, spara tvær klukkustundir á hverjum degi!

gull star1 300 Nýjar eiginleikar fyrir Excel, Gera Excel mjög auðvelt og öflugt:

  • Sameina Cell / Rows / dálka án þess að tapa gögnum.
  • Sameina og sameina margar töflur og vinnubækur.
  • Bera saman sviðum, afritaðu margar línur, umbreyta texta í dag, einingar og gjaldmiðil viðskipta.
  • Fjöldi með litum, síðuskiptafjölda, háþróaður flokkur og frábær sía,
  • Meira Veldu / Setja / Eyða / Texti / Snið / Link / Athugasemd / Vinnubækur / Verkstæði Verkfæri ...

Skjár skot af Kutools fyrir Excel

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Leah · 5 months ago
    Hello, this worked great. However, I have a report with 1000 entries and the code stopped duplicating around entry 480. Is there something that I can add so that it completes the action on the entire report?
    • To post as a guest, your comment is unpublished.
      skyyang · 5 months ago
      Hello, Leah,
      I have tested the code in 2000 rows, and it works well.
      Could you send your worksheet to me for testing the code?
      My email address is skyyang@extendoffice.com
      Look forward to your reply!
      • To post as a guest, your comment is unpublished.
        Leah · 5 months ago
        Hello! I got it to work. It was an error on my side, the report had a few blank rows that were hidden that were causing the script to stop looping. It worked for my report with 8,000 rows! Thank youQ
  • To post as a guest, your comment is unpublished.
    Jackie · 8 months ago
    So I am using this code but I want it to search the entire document not just row 1 or whatever is indicated by xRow = 1. I am trying to put in the range 1:2000 but it is not working. How can I identify xRow = any row on the sheet that includes the information I identify in the code below?


    Dim xRow As Long
    Dim Value As Variant


    xRow = 1: 2000

    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
    Value = Cells(xRow, "D")
    Value2 = Cells(xRow, "A")
    If Not ((Value = "allegheny general") And IsNumeric(Value2 = G0202)) Then
    Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
    Range(Cells(xRow + 1, "A"), Cells(xRow + 1, "D")).Select
    Selection.Insert Shift:=xlDown
    xRow = xRow + 1
    End If
    xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
    End Sub
  • To post as a guest, your comment is unpublished.
    Hayley · 9 months ago
    Do you know what the code would be to duplicate the row just the once, based on if say cell d contains 'Yes' - I have been chasing similar code but for something that will duplicate a row based on a cell saying yes
  • To post as a guest, your comment is unpublished.
    Steve · 11 months ago
    I used the code above which works great but I need one more step after the row is pasted. I just cannot get it to properly work. I need it to put zero in column "N" in the row after it is pasted but keep the value in "N" in the original copied row.


    Sub CopyData()
    'Updateby Extendoffice 20160922
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
    VInSertNum = Cells(xRow, "J")
    If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
    Range(Cells(xRow, "A"), Cells(xRow, "AN")).Copy
    ' Cells(xRow, 14).Value = 0 this did all rows
    Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "AN")).Select
    'Cells(xRow, 14).Value = 0
    'this did all rows
    Selection.Insert Shift:=xlDown
    ' Cells(xRow, 14).Value = 0 this did the first row only
    xRow = xRow + VInSertNum - 1
    'Cells(xRow - 1, 14).Value = 0
    End If
    ' Cells(xRow - 1, 14).Value = 0
    xRow = xRow + 1
    ' Cells(xRow + 1, 14).Value = 0
    Loop
    'Cells(xRow, 14).Value = 0 this did no rows
    Application.ScreenUpdating = False
    End Sub
  • To post as a guest, your comment is unpublished.
    OSHRI · 1 years ago
    Hi,
    Someone knows hot convert this VBA code to Google Apps scripts (google sheets)?