Συμβουλή: Άλλες γλώσσες μεταφράζονται από την Google. Μπορείτε να επισκεφθείτε το English έκδοση αυτής της σύνδεσης.
Σύνδεση
x
or
x
x
Κανε ΕΓΓΡΑΦΗ
x

or

Πώς να αντιγράψετε γραμμές βασισμένες στην τιμή κυψέλης σε μια στήλη;

Για παράδειγμα, έχω μια σειρά δεδομένων που περιέχει μια λίστα αριθμών στη στήλη D και τώρα θέλω να αντιγράψω ολόκληρες τις σειρές πολλές φορές με βάση τις αριθμητικές τιμές στη στήλη D για να λάβω το ακόλουθο αποτέλεσμα. Πώς μπορώ να αντιγράψω τις σειρές πολλές φορές με βάση τις τιμές κυττάρων στο Excel;

doc διπλές σειρές από το κελί 1

Διπλάσιες σειρές πολλαπλές φορές με βάση τις τιμές των κυττάρων με τον κώδικα VBA


arrow μπλε δεξιά φούσκα Διπλάσιες σειρές πολλαπλές φορές με βάση τις τιμές των κυττάρων με τον κώδικα VBA

Για να αντιγράψετε και να αντιγράψετε ολόκληρες τις σειρές πολλές φορές με βάση τις τιμές των κυττάρων, ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει, κάντε το εξής:

1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Κλίκ Κύριο θέμα > Μονάδα μέτρησης, και επικολλήστε τον ακόλουθο κώδικα στο Μονάδα μέτρησης Παράθυρο.

Κωδικός VBA: Διπλές σειρές πολλαπλές φορές με βάση την τιμή κυττάρων:

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. Στη συνέχεια πατήστε F5 για να εκτελέσετε αυτόν τον κώδικα, ολόκληρες οι σειρές έχουν αντιγραφεί πολλές φορές με βάση την τιμή κυττάρων στη στήλη D όπως χρειάζεστε.

Note: Στον παραπάνω κώδικα, το γράμμα A υποδηλώνει τη στήλη έναρξης της περιοχής δεδομένων σας και το γράμμα D είναι το γράμμα στήλης που θέλετε να αντιγράψετε τις σειρές με βάση. Παρακαλούμε να τις αλλάξετε στις ανάγκες σας.



Συνιστώμενα εργαλεία παραγωγικότητας

Καρτέλα Office

χρυσό star1 Φέρτε χρήσιμες καρτέλες στο Excel και άλλο λογισμικό του Office, όπως το Chrome, το Firefox και ο νέος Internet Explorer.

Kutools για το Excel

χρυσό star1 Φοβερο! Αυξήστε την παραγωγικότητά σας σε λεπτά 5. Δεν χρειάζεστε ειδικές δεξιότητες, εκτός από δύο ώρες κάθε μέρα!

χρυσό star1 300 Νέες δυνατότητες για Excel, Κάντε το Excel πολύ εύκολο και ισχυρό:

  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων.
  • Συνδυασμός και ενοποίηση πολλών φύλλων και βιβλίων εργασίας.
  • Συγκρίνετε Περιοχές, Αντιγραφή Πολλαπλών Εύρους, Μετατροπή Κειμένου σε Ημερομηνία, Μετατροπή μονάδας και νομίσματος.
  • Καταμέτρηση κατά Χρώματα, Υποσύνολα σελίδας, Σύνθετη Ταξινόμηση και Σούπερ Φίλτρο,
  • Περισσότερα Επιλογή / Εισαγωγή / Διαγραφή / Κείμενο / Μορφή / Σύνδεσμος / Σχόλιο / Βιβλία εργασίας / Φύλλα εργασίας Εργαλεία ...

Εικόνα του Kutools για το 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.
    David · 1 years ago
    Thank you! lines 10 and 11 "D" indicates the end of the row and this may need to be changed to your data range to make it work.
  • To post as a guest, your comment is unpublished.
    Sqril · 1 years ago
    I love you. Thank you.
  • To post as a guest, your comment is unpublished.
    Jamie · 1 years ago
    This worked perfectly. What would I add to your code to make any lines with '0' disappear? We are using this for SKU labels. Thanks for the great solution!