Note: The other languages of the website are Google-translated. Back to English

Πώς να εισαγάγετε συγκεκριμένο αριθμό σειρών σε σταθερά διαστήματα στο Excel;

Στο φύλλο εργασίας του Excel, μπορείτε να εισαγάγετε μια κενή σειρά μεταξύ των υπαρχουσών σειρών χρησιμοποιώντας τη λειτουργία Εισαγωγή. Αλλά, εάν έχετε ένα μεγάλο εύρος δεδομένων και, πρέπει να εισαγάγετε δύο κενές σειρές μετά από κάθε τρίτη σειρά, πώς θα μπορούσατε να ολοκληρώσετε αυτήν την εργασία γρήγορα και άνετα;


Εισαγάγετε συγκεκριμένο αριθμό κενών σειρών στο εύρος δεδομένων σε σταθερά διαστήματα με τον κώδικα VBA

Ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει να εισαγάγετε έναν συγκεκριμένο αριθμό σειρών μετά από κάθε ένατη σειρά στα υπάρχοντα δεδομένα. Κάντε τα εξής:

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

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

Κωδικός VBA: Εισαγάγετε συγκεκριμένο αριθμό σειρών σε δεδομένα σε σταθερά διαστήματα

Sub InsertRowsAtIntervals()
'Updateby Extendoffice
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
    xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
    Application.Selection.EntireRow.Insert
    xNum1 = xNum1 + xNum2
Next
End Sub

3. Αφού επικολλήσετε αυτόν τον κωδικό, πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα, θα εμφανιστεί ένα πλαίσιο προτροπής για να σας υπενθυμίσει ότι επιλέγετε το εύρος δεδομένων που θέλετε να εισαγάγετε κενές γραμμές, δείτε το στιγμιότυπο οθόνης:

4. Κλίκ OK κουμπί, θα εμφανιστεί ένα άλλο πλαίσιο προτροπής, εισαγάγετε τον αριθμό των διαστημάτων σειράς, δείτε το στιγμιότυπο οθόνης:

5. Κάντε κλικ OK κουμπί, στο ακόλουθο αναδυόμενο πλαίσιο προτροπής, εισαγάγετε τον αριθμό των κενών σειρών που θέλετε να εισαγάγετε, δείτε το στιγμιότυπο οθόνης:

6. Στη συνέχεια κάντε κλικ στο κουμπί OKκαι οι κενές σειρές έχουν εισαχθεί στα υπάρχοντα δεδομένα σε τακτά χρονικά διαστήματα, δείτε στιγμιότυπα οθόνης:


Εισαγάγετε συγκεκριμένο αριθμό κενών σειρών στο εύρος δεδομένων με βάση τις τιμές κελιού με τον κώδικα VBA

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

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

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

Κωδικός VBA: Εισαγάγετε συγκεκριμένο αριθμό κενών σειρών με βάση μια λίστα αριθμών:

Sub Insertblankrowsbynumbers ()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "Kutools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub

3. Αφού επικολλήσετε αυτόν τον κωδικό, πατήστε F5 για να εκτελέσετε αυτόν τον κώδικα, στο αναδυόμενο παράθυρο διαλόγου, επιλέξτε τη λίστα αριθμών στους οποίους θέλετε να εισαγάγετε κενές γραμμές βάσει, δείτε το στιγμιότυπο οθόνης:

4. Στη συνέχεια, κάντε κλικ στο κουμπί OKκαι θα λάβετε τα αποτελέσματα που χρειάζεστε ως εξής στιγμιότυπα οθόνης που εμφανίζονται:


Εισαγάγετε συγκεκριμένο αριθμό κενών σειρών στο εύρος δεδομένων σε σταθερά διαστήματα με μια εύχρηστη λειτουργία

Εάν δεν είστε εξοικειωμένοι με τον παραπάνω κώδικα VBA, Kutools για Excel μπορεί επίσης να σας βοηθήσει, αυτό Εισαγωγή κενών γραμμών & στηλών Η δυνατότητα μπορεί να εισαγάγει συγκεκριμένο αριθμό σειρών ή στηλών σε υπάρχοντα δεδομένα σε σταθερά διαστήματα γρήγορα και εύκολα.

Σημείωση:Για να το εφαρμόσετε Εισαγωγή κενών γραμμών & στηλών , πρώτα, πρέπει να κατεβάσετε το Kutools για Excelκαι, στη συνέχεια, εφαρμόστε τη λειτουργία γρήγορα και εύκολα.

Μετά την εγκατάσταση Kutools για Excel, κάντε τα εξής:

1. Επιλέξτε το εύρος δεδομένων που θέλετε να εισαγάγετε κενές σειρές ανά διαστήματα.

2. Κλίκ Kutools > Κύριο θέμα > Εισαγωγή κενών γραμμών & στηλών, δείτε το στιγμιότυπο οθόνης:

3. Στην Εισαγωγή κενής σειράς & στηλών , επιλέξτε Κενές σειρές επιλογή από το Εισαγωγή τύπουκαι, στη συνέχεια, καθορίστε τον αριθμό των διαστημάτων και των κενών γραμμών που θέλετε να χρησιμοποιήσετε όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης:

4. Στη συνέχεια κάντε κλικ στο κουμπί OK κουμπί και οι κενές σειρές έχουν εισαχθεί στο επιλεγμένο εύρος σε ένα συγκεκριμένο διάστημα όπως φαίνεται το ακόλουθο στιγμιότυπο οθόνης:

Κατεβάστε και δωρεάν δοκιμή Kutools για Excel τώρα!


Αντιγράψτε και εισαγάγετε σειρές πολλές φορές με βάση συγκεκριμένους αριθμούς με κωδικό VBA

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

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

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

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

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

Sub CopyRows()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
SelectRange:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the list of numbers to copy the rows based on: ", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then
MsgBox "Please select single column!"
GoTo SelectRange
End If
Application.ScreenUpdating = False
For xFNum = xRg.Count To 1 Step -1
Set xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
With Rows(xCRg.Row)
.Copy
.Resize(xRN).Insert
End With
Next
Application.ScreenUpdating = True
End Sub

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

4. Στη συνέχεια, κάντε κλικ στο κουμπί OK κουμπί και ο συγκεκριμένος αριθμός σειρών έχει αντιγραφεί και επικολληθεί σε κάθε αρχική σειρά, δείτε στιγμιότυπα οθόνης:


Αντιγράψτε και εισαγάγετε σειρές πολλές φορές με βάση συγκεκριμένους αριθμούς με εκπληκτική δυνατότητα

Εάν έχετε Kutools για Excel, Με τους Διπλότυπες σειρές / στήλες με βάση την τιμή κελιού δυνατότητα, μπορείτε να εισαγάγετε τις γραμμές ή τις στήλες με βάση τη λίστα αριθμών γρήγορα και εύκολα.

Σημείωση:Για να το εφαρμόσετε Διπλότυπες σειρές / στήλες με βάση την τιμή κελιού, πρώτα, πρέπει να κατεβάσετε το Kutools για Excelκαι, στη συνέχεια, εφαρμόστε τη λειτουργία γρήγορα και εύκολα.

Μετά την εγκατάσταση Kutools για Excel, κάντε τα εξής:

1. Κλίκ Kutools > Κύριο θέμα > Διπλότυπες σειρές / στήλες με βάση την τιμή κελιού, δείτε το στιγμιότυπο οθόνης:

2. Στην Αντιγράψτε και εισαγάγετε σειρές και στήλες , επιλέξτε Αντιγραφή και εισαγωγή γραμμών επιλογή του Τύπος ενότητα και, στη συνέχεια, επιλέξτε το εύρος δεδομένων που θέλετε να αντιγράψετε και, στη συνέχεια, καθορίστε τη λίστα τιμών που θέλετε να αντιγράψετε σειρές βάσει, δείτε το στιγμιότυπο οθόνης:

4. Στη συνέχεια, κάντε κλικ στο κουμπί Ok or Εφαρμογή κουμπί, θα λάβετε το ακόλουθο αποτέλεσμα όπως χρειάζεστε:

Κατεβάστε και δωρεάν δοκιμή Kutools για Excel τώρα!

Σχετικά άρθρα:

  • Αντιγράψτε και εισαγάγετε τη σειρά πολλές φορές ή αντιγράψτε τις σειρές X Times
  • Στην καθημερινή σας εργασία, έχετε προσπαθήσει ποτέ να αντιγράψετε μια σειρά ή κάθε σειρά και, στη συνέχεια, να εισαγάγετε πολλές φορές κάτω από την τρέχουσα σειρά δεδομένων σε ένα φύλλο εργασίας; Για παράδειγμα, έχω μια σειρά κελιών, τώρα, θέλω να αντιγράψω κάθε σειρά και να τα επικολλήσω 3 φορές στην επόμενη σειρά, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης. Πώς θα μπορούσατε να αντιμετωπίσετε αυτήν την εργασία στο Excel;
  • Εισαγωγή κενών γραμμών όταν αλλάζει η τιμή στο Excel
  • Ας υποθέσουμε ότι έχετε μια σειρά δεδομένων και τώρα θέλετε να εισαγάγετε κενές σειρές μεταξύ των δεδομένων όταν αλλάζει η τιμή, έτσι ώστε να μπορείτε να διαχωρίσετε τις διαδοχικές ίδιες τιμές σε μία στήλη όπως εμφανίζονται τα ακόλουθα στιγμιότυπα οθόνης. Σε αυτό το άρθρο, θα μιλήσω για μερικά κόλπα για να λύσετε αυτό το πρόβλημα.
  • Αντιγράψτε σειρές από πολλά φύλλα εργασίας βάσει κριτηρίων σε ένα νέο φύλλο
  • Ας υποθέσουμε, έχετε ένα βιβλίο εργασίας με τρία φύλλα εργασίας που έχουν την ίδια μορφοποίηση με το παρακάτω στιγμιότυπο οθόνης. Τώρα, θέλετε να αντιγράψετε όλες τις σειρές από αυτά τα φύλλα εργασίας που η στήλη Γ περιέχει το κείμενο "Ολοκληρώθηκε" σε ένα νέο φύλλο εργασίας. Πώς θα μπορούσατε να επιλύσετε αυτό το πρόβλημα γρήγορα και εύκολα χωρίς να τα αντιγράψετε και να επικολλήσετε ένα προς ένα χειροκίνητα;

Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2021 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (39)
Βαθμολογήθηκε το 5 από το 5 · αξιολογήσεις 2
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, χρησιμοποιώ τον κωδικό σας (παρακάτω) μπορείτε να μου πείτε πώς μπορώ να γεμίσω αυτές τις σειρές με προσαρμοσμένο κείμενο σε αυτόν. Χρησιμοποίησα τον κωδικό σας για να εισαγάγετε τρεις σειρές και λειτούργησε τέλεια, αλλά τώρα πρέπει να εισαγάγω το κείμενο Row1 = Date Row2.= Τοποθεσία Row3 = Αριθμός τηλεφώνου Ευχαριστώ εκ των προτέρων... "Sub InsertRowsAtIntervals() 'Updateby20150707 Dim Rng As Range Dim xInterval ως ακέραιος Dim xRows ως ακέραιος dim xRowsCount ως ακέραιος dim xNum1 ως ακέραιος αριθμός dim xNum2 ως ακέραιος αριθμός Dim WorkRng ως εύρος Dim xWs ως φύλλο εργασίας xTitleId = "KutoolsforExcel" Set WorkRng = Application.Rngeangean"d , WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("Πόσες σειρές έως εισαγωγή σε κάθε διάστημα; ", xTitleId, 1, Τύπος:=1) xNum1 = WorkRng.Row + xInterval xNum2 = xRows + xInterval Set xWs = WorkRng.Parent For i = 1 To Int(xRowsCount / xInterval) xWs.Range(xWs .Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Επιλέξτε Application.Selection.EntireRow.Insert xNum1= xNum1 + xNum2 Επόμενο τέλος Υπο"
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
σε ευχαριστώ πάρα πολύ!!!!! Αυτό είναι καταπληκτικό
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ!!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi


Χρησιμοποιώ τον κωδικό διαστήματος vba λειτουργεί..Αλλά όταν χρησιμοποιώ πάνω από 100000 σειρές δεν λειτουργεί.. προτείνετε τι πρέπει να αλλάξω εάν υπάρχει.


SubInsertRowsAtIntervals()
«Ενημέρωση έως το 20150707
Dim Rng ως εμβέλεια
Dim xInterval ως ακέραιος αριθμός
Dim xRows ως ακέραιος
Dim xRowsCount ως ακέραιος
Dim xNum1 ως ακέραιος αριθμός
Dim xNum2 ως ακέραιος αριθμός
Dim WorkRng As Range
Dim xWs ως φύλλο εργασίας
xTitleId = "KutoolsforExcel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Εισαγωγή διαστήματος σειράς. ", xTitleId, 1, Τύπος:=1)
xRows = Application.InputBox("Πόσες σειρές να εισαχθούν σε κάθε διάστημα; ", xTitleId, 1, Τύπος:=1)
xNum1 = WorkRng.Σειρά + xInterval
xNum2 = xRows + xInterval
Ορισμός xWs = WorkRng.Parent
Για i = 1 To Int (xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Επιλέξτε
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Επόμενο
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Φανταστικό - μου γλυτώσατε πολλές άσκοπες καταχωρίσεις δεδομένων, σας ευχαριστώ πολύ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια πώς μπορώ να λάβω τον κωδικό για Εισαγωγή συγκεκριμένου αριθμού στηλών σε δεδομένα σε σταθερά χρονικά διαστήματα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου, PK,
Για να εισάγετε κενές στήλες σε υπάρχοντα δεδομένα σε συγκεκριμένα χρονικά διαστήματα, ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει! Παρακαλώ δοκιμάστε το.

SubInsertColumnsAtIntervals()
Dim Rng ως εμβέλεια
Dim xInterval ως ακέραιος αριθμός
Dim xCs ως ακέραιος αριθμός
Dim xCCcount ως ακέραιος
Dim xNum1 ως ακέραιος αριθμός
Dim xNum2 ως ακέραιος αριθμός
Dim WorkRng As Range
Dim xWs ως φύλλο εργασίας
xTitleId = "KutoolsforExcel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xCCcount = WorkRng.Columns.Count
xInterval = Application.InputBox("Εισαγωγή διαστήματος στήλης. ", xTitleId, 1, Τύπος:=1)
xCs = Application.InputBox("Πόσες στήλες να εισαχθούν σε κάθε διάστημα; ", xTitleId, 1, Τύπος:=1)
xNum1 = WorkRng.Στήλη + xInterval
xNum2 = xCs + xInterval
Ορισμός xWs = WorkRng.Parent
Για I = 1 To Int(xCCcount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Επιλέξτε
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
Επόμενο
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς να προσθέσετε σειρές σε δεδομένα excel σύμφωνα με τον αναφερόμενο αριθμό στο τελευταίο κελί, ας πούμε σε δεδομένα excel, εάν το τελευταίο κελί εμφανίζει τον αριθμό ως 4, ποιος είναι ο τρόπος για να dd 4 σειρές αυτόματα. σε μια άλλη σειρά ο αριθμός είναι 72, κ.λπ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, SPGupta,
Για να εισαγάγετε κενές σειρές βάσει συγκεκριμένης λίστας αριθμών, εφαρμόστε τον παρακάτω κώδικα VBA.
Παρακαλώ δοκιμάστε, ελπίζω ότι μπορεί να σας βοηθήσει!

SubInsert()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Συνέχιση Επόμενη
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη στήλη του συγκεκριμένου αριθμού προς χρήση (μονή στήλη):", "KuTools For Excel", xAddress, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Σειρά
xFstRow = xRg.Σειρά
xCol = xRg.Στήλη
xCount = xRg.Count
Ορισμός xRg = xRg(1)
Για I = xLastRow To xFstRow Βήμα -1
xNum = Κελιά (I, xCol)
Αν IsNumeric(xNum) Και xNum > 0 Τότε
Γραμμές (I + 1). Αλλαγή μεγέθους (xNum). Εισαγωγή
xCount = xCount + xNum
End If
Επόμενο
xRg.Resize(xCount, 1).Επιλέξτε
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, θα μπορούσατε να με βοηθήσετε, σας παρακαλώ; Πώς μπορώ να αλλάξω αυτόν τον κώδικα για να διαφημίσω μία ακόμη λιγότερες σειρές από τον αριθμό στο κελί; Για παράδειγμα, εάν ο αριθμός στο κελί είναι 4, προγραμματίστε να προσθέσετε 3 σειρές. Εάν ο αριθμός στο κελί είναι 1, οι σειρές δεν προστίθενται
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Νίνα,
Για να λύσετε την εργασία σας, χρησιμοποιήστε τον παρακάτω κώδικα:

SubInsert()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Συνέχιση Επόμενη
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη στήλη του συγκεκριμένου αριθμού προς χρήση (μονή στήλη):", "KuTools For Excel", xAddress, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Σειρά
xFstRow = xRg.Σειρά
xCol = xRg.Στήλη
xCount = xRg.Count
Ορισμός xRg = xRg(1)
Για I = xLastRow To xFstRow Βήμα -1
xNum = Κελιά (I, xCol)
xNum = xNum - 1
Αν IsNumeric(xNum) Και xNum > 0 Τότε
Γραμμές (I + 1). Αλλαγή μεγέθους (xNum). Εισαγωγή
xCount = xCount + xNum
End If
Επόμενο
xRg.Resize(xCount, 1).Επιλέξτε
Application.ScreenUpdating = True
Sub End


Παρακαλώ δοκιμάστε, ελπίζω ότι μπορεί να σας βοηθήσει!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λειτουργεί τέλεια, ευχαριστώ πολύ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό είναι υπέροχο. Απλώς αναρωτιέμαι... και τα αγγλικά μου δεν είναι τέλεια οπότε ελπίζω να με καταλάβετε :) .....
Είναι δυνατόν να γεμίσουμε τις προστιθέμενες κενές σειρές με τιμές από τη γραμμή όπου ήταν αυτός ο παραμετρικός αριθμός;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, Vladimir, Εννοείτε να εισαγάγετε κενές σειρές με βάση μια λίστα αριθμών στο φύλλο εργασίας; Εάν ναι, εφαρμόστε τον παρακάτω κωδικό:
SubInsert()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Συνέχιση Επόμενη
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη λίστα των αριθμών που θέλετε να εισαγάγετε σειρές με βάση:", "KuTools For Excel", xAddress, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Σειρά
xFstRow = xRg.Σειρά
xCol = xRg.Στήλη
xCount = xRg.Count
Ορισμός xRg = xRg(1)
Για I = xLastRow To xFstRow Βήμα -1
xNum = Κελιά (I, xCol)
Αν IsNumeric(xNum) Και xNum > 0 Τότε
Γραμμές (I + 1). Αλλαγή μεγέθους (xNum). Εισαγωγή
xCount = xCount + xNum
End If
Επόμενο
xRg.Resize(xCount, 1).Επιλέξτε
Application.ScreenUpdating = True
Τέλος δευτερεύοντος Παρακαλώ δοκιμάστε το, εάν έχετε άλλες ερωτήσεις, παρακαλώ σχολιάστε εδώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτός ο κώδικας είναι τέλειος για την εισαγωγή σειρών....Sub Insert()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Συνέχιση Επόμενη
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη στήλη του συγκεκριμένου αριθμού προς χρήση (μονή στήλη):", "KuTools For Excel", xAddress, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Σειρά
xFstRow = xRg.Σειρά
xCol = xRg.Στήλη
xCount = xRg.Count
Ορισμός xRg = xRg(1)
Για I = xLastRow To xFstRow Βήμα -1
xNum = Κελιά (I, xCol)
xNum = xNum - 1
Αν IsNumeric(xNum) Και xNum > 0 Τότε
Γραμμές (I + 1). Αλλαγή μεγέθους (xNum). Εισαγωγή
xCount = xCount + xNum
End If
Επόμενο
xRg.Resize(xCount, 1).Επιλέξτε
Application.ScreenUpdating = True
Sub End

Αλλά είναι δυνατόν... να αντιγράψετε δεδομένα σε αυτά τα κενά κελιά από τη σειρά που ήταν αυτός ο παραμετρικός αριθμός; Μπορώ να δημοσιεύσω εδώ φωτογραφία; Ίσως είναι πιο εύκολο αν σου δείξω αυτό που χρειάζομαι :)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, Vladimir, Ίσως ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει, δοκιμάστε τον. Sub CopyRow()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xCRg ως εύρος
Dim xFNum ως ακέραιος αριθμός
Dim xRN ως ακέραιος αριθμός
On Error Συνέχιση Επόμενη
Select Range:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη λίστα αριθμών", "Kutools για Excel", xTxt, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub

Αν xRg.Columns.Count > 1 Τότε
MsgBox "Παρακαλώ επιλέξτε μία στήλη!"
Μετάβαση στο SelectRange
End If
Application.ScreenUpdating = False
Για xFNum = xRg. Μετρήστε στο 1 Βήμα -1
Ορισμός xCRg = xRg.Item(xFNum)
xRN = CIint(xCRg.Value)
Με σειρές (xCRg.Row)
.Αντίγραφο
.Αλλαγή μεγέθους(xRN).Εισαγωγή
Τέλος με
Επόμενο
Application.ScreenUpdating = True
Sub End

Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Είμαστε τόσο κοντά :) Το μόνο που χρειάζομαι τώρα είναι μια σειρά λιγότερη από τον προηγούμενο κώδικα VBA, από την τιμή του παραμετρικού αριθμού. Για παράδειγμα: Εάν ο αριθμός είναι 8, πρέπει να εισαγάγουμε και να αντιγράψουμε 7 σειρές. Όπως έκανες για τη Νίνα μόνο με αυτό το ΑΝΤΙΓΡΑΦΟ
Έτσι, εάν ο αριθμός είναι 8, τότε θα πρέπει να έχουμε συνολικά 8 εισαγόμενες και αντιγραμμένες σειρές και με τον προηγούμενο κωδικό VBA έχουμε 9.
tnx
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Σε αυτήν την περίπτωση, ο παρακάτω κώδικας μπορεί να σας βοηθήσει, δοκιμάστε: Sub CopyData()
'Ενημέρωση Extendoffice
Dim xRow As Long
Dim VinSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do while (Κελιά(xRow, "A") <> "")
VInSertNum = Κελιά(xRow, "B")
Εάν ((VInSertNum > 1) And IsNumeric(VInSertNum)) Τότε
Εύρος(Κελιά(xRow, "A"), Cells(xRow, "B")).Αντιγραφή
Εύρος (Κελιά(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "B")).Επιλέξτε
Επιλογή. Εισαγωγή αλλαγής: = xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Βρόχος
Application.ScreenUpdating = False
Τέλος Υποσημείωση: Στον παραπάνω κωδικό, το γράμμα A υποδεικνύει τη στήλη έναρξης του εύρους δεδομένων σας και το γράμμα B είναι το γράμμα στήλης στο οποίο θέλετε να αντιγράψετε τις σειρές βάσει. Αλλάξτε τα ανάλογα με τις ανάγκες σας.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχετε μια ενότητα που αφαιρεί τον αριθμό που αντιγράφηκε κατά ένα;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Όχι. Έχω αυτό, αλλά το χρειάζομαι για να αφαιρέσω 1;
Sub CopyRow()
'ΕνημέρωσηExtendoffice
Dim xRg ως εύρος
Dim xCRg ως εύρος
Dim xFNum ως ακέραιος αριθμός
Dim xRN ως ακέραιος αριθμός
On Error Συνέχιση Επόμενη
Select Range:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Επιλέξτε τη λίστα αριθμών", "Kutools για Excel", xTxt, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub

Αν xRg.Columns.Count > 1 Τότε
MsgBox "Παρακαλώ επιλέξτε μία στήλη!"
Μετάβαση στο SelectRange
End If
Application.ScreenUpdating = False
Για xFNum = xRg. Μετρήστε στο 1 Βήμα -1
Ορισμός xCRg = xRg.Item(xFNum)
xRN = CIint(xCRg.Value)
Με σειρές (xCRg.Row)
.Αντίγραφο
.Αλλαγή μεγέθους(xRN).Εισαγωγή
Τέλος με
Επόμενο
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό που προσπαθώ να κάνω είναι να δημιουργήσω και να εκτυπώσω ετικέτες στο Word από ένα υπολογιστικό φύλλο με πολλές ποσότητες;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Είχες την ευκαιρία να το δεις αυτό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ο χρυσός να σε ευλογεί
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αναζητάτε κώδικα για τη δημιουργία μιας λίστας excel που αντιγράφεται με έναν αριθμό σε ένα κελί και αφαιρεί 1 για το πρωτότυπο;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ συγγραφέα! Σου αξίζει ο καλύτερος έπαινος για αυτά! Αλλά θα μπορούσατε να με βοηθήσετε με τον κώδικα για να βάλω μια σταθερή τιμή σε όλες τις κενές σειρές που δημιούργησα με τον κώδικά σας παραπάνω; Για να γίνω πιο σαφής, πρέπει να εισαγάγω μια σταθερή τιμή σε όλες τις κενές σειρές (αυτό έχει λυθεί ήδη με τον κωδικό σας παραπάνω) και στη συνέχεια πρέπει να εισαγάγω μια σταθερή τιμή σε όλες τις κενές σειρές (αυτό είναι το πρόβλημά μου). Σας ευχαριστώ καθώς περιμένω την ευγενική σας ανταπόκριση.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, Εννοείτε να γεμίσετε κενές σειρές με συγκεκριμένη τιμή; Αν ναι, ίσως το παρακάτω άρθρο μπορεί να σας βοηθήσει:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Παρακαλώ δοκιμάστε το.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μπορώ να λάβω τον κωδικό VBA για τη διαγραφή σειρών που βασίζονται σε διπλότυπες τιμές σε μια επιλεγμένη στήλη διατηρώντας όλες τις μοναδικές τιμές;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Roy, Εάν θέλετε να αφαιρέσετε σειρές που βασίζονται σε διπλότυπες τιμές, συνήθως, μπορείτε να χρησιμοποιήσετε το Κατάργηση διπλότυπων δυνατότητα στο Excel για την κατάργηση των σειρών. Φυσικά, εάν χρειάζεστε κωδικό VBA, χρησιμοποιήστε τον παρακάτω κώδικα: (Πρώτα, θα πρέπει να επιλέξετε το εύρος δεδομένων που θέλετε να καταργήσετε και, στη συνέχεια, να εκτελέσετε αυτόν τον κώδικα, τις σειρές που βασίζονται στο διπλότυπες τιμές στην πρώτη στήλη της επιλογής σας θα αφαιρεθούν αμέσως. ) Sub Delete_duplicate_rows()
Dim Rng ως εμβέλεια
Ορισμός Rng = Επιλογή
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
Τέλος ΥποΠαρακαλώ δοκιμάστε, ελπίζω να σας βοηθήσει!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό είναι τόσο Cool!! Ευχαριστώ πολύ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Muito obrigado, salvou meu trabalho, eu não tinha ideia de como fazer. Muito obrigado mesmo!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χαίρετε Κ.
Παρακαλώ. Χαίρομαι που βοηθάει. Οποιεσδήποτε ερωτήσεις, μη διστάσετε να επικοινωνήσετε μαζί μας. Να έχεις μια υπέροχη μέρα.
Με αγάπη,
Mandy
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
μπορείτε να μου πείτε πώς να εισάγω στήλη με αυτόν τον τρόπο, ποιος είναι ο κωδικός
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου φίλος,
Μπορείτε να χρησιμοποιήσετε αυτόν τον κώδικα VBA:

Sub InsertColumnsAtIntervals()

'Updateby Extendoffice

Dim Rng As Range

Dim xInterval As Integer

Dim xColumns As Integer

Dim xColumnsCount As Integer

Dim xNum1 As Integer

Dim xNum2 As Integer

Dim WorkRng As Range

Dim xWs As Worksheet

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

xColumnsCount = WorkRng.Columns.Count

xInterval = Application.InputBox("Enter column interval. ", xTitleId, 1, Type:=1)

xColumns = Application.InputBox("How many columns to insert at each interval? ", xTitleId, 1, Type:=1)

xNum1 = WorkRng.Column + xInterval

xNum2 = xColumns + xInterval

Set xWs = WorkRng.Parent

For i = 1 To Int(xColumnsCount / xInterval)

    xWs.Range(xWs.Cells(WorkRng.Row, xNum1), xWs.Cells(WorkRng.Row, xNum1 + xColumns - 1)).Select

    Application.Selection.EntireColumn.Insert

    xNum1 = xNum1 + xNum2

Next

End Sub


Με αγάπη,
Mandy
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Βαθμολογήθηκε το 5 από το 5
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Όνομα Email Διεύθυνση τηλεφώνου
0 Όνομα Email Διεύθυνση τηλεφώνου
γραμμή διεύθυνσης 2 Όνομα Τηλέφωνο 0
Όνομα Email Διεύθυνση τηλεφώνου
0 Όνομα Email Διεύθυνση τηλεφώνου
γραμμή διεύθυνσης 2 0


Πώς θα μπορούσα να το επεξεργαστώ για να ξεκινήσω μια νέα σειρά σε κάθε κενή τιμή ή τιμή 0 χωρίς να έχω αριθμούς τηλεφώνου με 0 να ξεκινούν μια νέα σειρά;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Τζάροντ

Συγγνώμη, δεν μπορώ να καταλάβω ξεκάθαρα το πρόβλημά σας.
Θα μπορούσατε να εξηγήσετε το πρόβλημά σας πιο αναλυτικά; Ή μπορείτε να εισαγάγετε ένα στιγμιότυπο οθόνης ή ένα αρχείο εδώ.
Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
hola, hay algun codigo que me permita copiar los datos, pero que en la primera columna que son fechas pueda ser consecutivo.

παράδειγμα

en vez de que quede asi

01/10/2022 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez

quede asi

01/10/2022 19.258.369-4 Juan Ramirez
02/10/2022 19.258.369-4 Juan Ramirez
03/10/2022 19.258.369-4 Juan Ramirez

gracias
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
hola, hay algun codigo que me permita copiar los datos, pero que en la primera columna que son fechas puedan ser consecutivas.

παράδειγμα

en vez de que quede asi

10/01/2022 19.258.369-4 Juan Ramirez
10/01/2022 19.258.369-4 Juan Ramirez
10/01/2022 19.258.369-4 Juan Ramirez

quede asi

10/01/2022 19.258.369-4 Juan Ramirez
11/01/2022 19.258.369-4 Juan Ramirez
12/01/2022 19.258.369-4 Juan Ramirez

gracias
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπέροχο σενάριο vba!
Είχα πάνω από 5000 σειρές στις οποίες πρέπει να προσθέσω νέες σειρές στο ενδιάμεσο. Όλοι οι άλλοι οδηγοί μου είπαν να φτιάξω τη στήλη "βοηθητικός", θα μου έπαιρνε μέρος της ζωής μου για να προσθέσω 1,2 αντιγραφή επικόλλησης ξανά και ξανά μόνο για να προσθέσω νέες σειρές.
Λοιπόν, ευχαριστώ για αυτό!
Βαθμολογήθηκε το 5 από το 5
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL