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

Πώς να εισαγάγετε αυτόματα σειρά με βάση την τιμή κελιού στο Excel;

doc-insert-row-based-on-value-1
Ας υποθέσουμε ότι έχετε μια σειρά δεδομένων και θέλετε να εισαγάγετε αυτόματα κενές γραμμές πάνω ή κάτω από μια συγκεκριμένη τιμή στο Excel, για παράδειγμα, αυτόματη εισαγωγή σειρών κάτω από τη μηδενική τιμή όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης. Στο Excel, δεν υπάρχει άμεσος τρόπος επίλυσης αυτής της εργασίας, αλλά μπορώ να εισαγάγω έναν κώδικα μακροεντολής για να εισαγάγετε αυτόματα γραμμές βάσει μιας συγκεκριμένης τιμής στο Excel.
Εισαγάγετε την παρακάτω σειρά με βάση την τιμή κελιού με το VBA

Εισαγάγετε την παραπάνω γραμμή με βάση την τιμή κελιού με το Kutools για Excel καλή ιδέα3

Για να εισαγάγετε σειρά με βάση την τιμή κελιού εκτελώντας το VBA, κάντε τα παρακάτω βήματα:

1. Τύπος Alt + F11 ταυτόχρονα πλήκτρα, και a Microsoft Visual Basic για εφαρμογές αναδύεται το παράθυρο.

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

VBA: Εισαγάγετε την παρακάτω σειρά με βάση την τιμή κελιού.

Sub BlankLine()
	'Updateby20150203
	Dim Rng As Range
	Dim WorkRng As Range
	On Error Resume Next
	xTitleId                   = "KutoolsforExcel"
	Set WorkRng                = Application.Selection
	Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
	Set WorkRng                = WorkRng.Columns(1)
	xLastRow                   = WorkRng.Rows.Count
	Application.ScreenUpdating = False
	For xRowIndex = xLastRow To 1 Step - 1
		Set Rng                   = WorkRng.Range("A" & xRowIndex)
		If Rng.Value = "0" Then
			Rng.Offset(1, 0).EntireRow.Insert Shift: = xlDown
		End If
	Next
	Application.ScreenUpdating = True
End Sub

3. κλικ F5 κλειδί ή το τρέξιμο κουμπί, εμφανίζεται ένα παράθυρο διαλόγου και επιλέξτε τη στήλη περιέχει μηδέν. Δείτε το στιγμιότυπο οθόνης:
doc-insert-row-based-on-value-2

4. κλικ OK. Στη συνέχεια, θα εισαχθούν κενές γραμμές κάτω από τη μηδενική τιμή.
doc-insert-row-based-on-value-3

Άκρο:

1. Εάν θέλετε να εισαγάγετε σειρές με βάση άλλη τιμή, μπορείτε να αλλάξετε 0 σε οποιαδήποτε τιμή θέλετε στο VBA: Εάν Rng.Value = "0" τότε.

2. Εάν θέλετε να εισαγάγετε σειρές πάνω από το μηδέν ή άλλη τιμή, μπορείτε να χρησιμοποιήσετε τον παρακάτω κώδικα vba.

VBA: Εισαγωγή σειρά πάνω από τη μηδενική τιμή:

Sub BlankLine()
	'Updateby20150203
	Dim Rng As Range
	Dim WorkRng As Range
	On Error Resume Next
	xTitleId                   = "KutoolsforExcel"
	Set WorkRng                = Application.Selection
	Set WorkRng                = Application.InputBox("Range", xTitleId, WorkRng.Address, Type: = 8)
	Set WorkRng                = WorkRng.Columns(1)
	xLastRow                   = WorkRng.Rows.Count
	Application.ScreenUpdating = False
	For xRowIndex = xLastRow To 1 Step - 1
		Set Rng                   = WorkRng.Range("A" & xRowIndex)
		If Rng.Value = "0" Then
			Rng.EntireRow.Insert Shift: = xlDown
		End If
	Next
	Application.ScreenUpdating = True
End Sub

doc-insert-row-based-on-value-4


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

Kutools για Excel, με περισσότερα από 300 εύχρηστες λειτουργίες, διευκολύνει τις εργασίες σας. 

Μετά την εγκατάσταση Kutools για Excel, κάντε τα παρακάτω:(Δωρεάν λήψη Kutools για Excel τώρα!)

1. Επιλέξτε τη λίστα από την οποία θέλετε να μάθετε τα συγκεκριμένα κελιά και κάντε κλικ στο Kutools > Αγορά > Επιλέξτε συγκεκριμένα κελιά. Δείτε το στιγμιότυπο οθόνης:
doc εισαγωγή σειράς με βάση την τιμή 9

2. Στο αναδυόμενο παράθυρο διαλόγου, επιλέξτε Ολόκληρη σειρά και μετά πηγαίνετε για να επιλέξετε ισούται από Ειδικός τύπος λίστα και, στη συνέχεια, εισαγάγετε την τιμή που θέλετε να βρείτε στο σωστό πλαίσιο κειμένου. Δείτε το στιγμιότυπο οθόνης:
doc εισαγωγή σειράς με βάση την τιμή 6

3. κλικ Okκαι εμφανίζεται ένα παράθυρο διαλόγου για να σας υπενθυμίσει τον αριθμό των επιλεγμένων σειρών, απλώς κλείστε τον.

4. Τοποθετήστε τον κέρσορα σε μια επιλεγμένη σειρά και κάντε δεξί κλικ για να επιλέξετε Κύριο θέμα από το μενού περιβάλλοντος. Δείτε το στιγμιότυπο οθόνης:
doc εισαγωγή σειράς με βάση την τιμή 7

Τώρα οι σειρές εισάγονται παραπάνω με βάση μια συγκεκριμένη τιμή.
doc εισαγωγή σειράς με βάση την τιμή 8


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


Τα καλύτερα εργαλεία παραγωγικότητας του 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% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (43)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θέλω να επικολλήσω συγκεκριμένο περιεχόμενο κάτω από το κελί. Πώς να το κάνω αυτό? Αντί για Κενή γραμμή, θέλω να εισαγάγω τιμή σε λίγες στήλες.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, θέλω να εισαγάγω πολλές σειρές με βάση την τιμή Π.χ.: Θέλω να εισαγάγω 1 κενή γραμμή κάτω από το κελί με τιμή 2, 2 σειρές κάτω από το κελί με τιμή 3, 3 σειρές κάτω από το κελί με τιμή 4 και ούτω καθεξής Can you παρακαλώ βοηθήστε με με αυτό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πήρατε ποτέ απάντηση σε αυτό; Προσπαθώ να κάνω το ίδιο πράγμα.

Έχετε μια λίστα υπαλλήλων με # εβδομάδων διακοπών που έχουν. Θέλω να εισάγω μια σειρά για κάθε εβδομάδα. Θα είναι 1, 2 ή 3 σειρές ανάλογα με τον χρόνο που έχουν κερδίσει. τα #s 1 2 3 είναι ήδη στο υπολογιστικό φύλλο μου.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θέλω να εισαγάγω σειρές με βάση μια καταμέτρηση χρησιμοποιώντας μια τιμή κελιού σε ένα υπολογιστικό φύλλο και εισάγοντας σειρές σε ένα άλλο υπολογιστικό φύλλο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χάρη στο μήνυμά σας. Μπορείτε όμως να περιγράψετε την ερώτησή σας με περισσότερες λεπτομέρειες; Ποιες σειρές θέλετε να εισαγάγετε; Κενό? Και πού θέλετε να εισάγετε στο φύλλο; Αν μπορείς, δώσε μου ένα στιγμιότυπο οθόνης. Σας ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Σ'αγαπώ. Σας ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ήταν καταπληκτικό!!. Ευχαριστώ φίλε.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορώ να εισάγω περισσότερες από μία σειρές;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μπορείτε να δοκιμάσετε αυτό το VBA

Sub BlankLine()
«Ενημέρωση έως το 20150203
Dim Rng ως εμβέλεια
Dim WorkRng As Range
Dim xInsertNum As Long
' Στο Σφάλμα Συνέχιση Επόμενο
xTitleId = "Kutools για Excel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Εάν το WorkRng δεν είναι τίποτα, τότε βγείτε από το Sub
xInsertNum = Application.InputBox("Ο αριθμός των κενών σειρών που θέλετε να εισαγάγετε", xTitleId, Τύπος:=1)
Αν xInsertNum = False Τότε
MsgBox " Ο αριθμός των κενών σειρών που θέλετε να εισαγάγετε ", vbInformation, xTitleId
Έξοδος Sub
End If
Ορισμός WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
Για xRowIndex = xLastRow To 1 Step -1
Ορισμός Rng = WorkRng.Range("A" & xRowIndex)
Εάν Rng.Value = "0" τότε
Rng.Resize(xInsertNum).EntireRow.Insert Shift:=xlDown
End If
Επόμενο
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
εάν θέλετε να εισαγάγετε κενές σειρές παρακάτω, δοκιμάστε αυτό

Sub BlankLine()
«Ενημέρωση έως το 20150203
Dim Rng ως εμβέλεια
Dim WorkRng As Range
Dim xInsertNum As Long
' Στο Σφάλμα Συνέχιση Επόμενο
xTitleId = "Kutools για Excel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Εάν το WorkRng δεν είναι τίποτα, τότε βγείτε από το Sub
xInsertNum = Application.InputBox("Ο αριθμός των κενών σειρών που θέλετε να εισαγάγετε", xTitleId, Τύπος:=1)
Αν xInsertNum = False Τότε
MsgBox " Ο αριθμός των κενών σειρών που θέλετε να εισαγάγετε ", vbInformation, xTitleId
Έξοδος Sub
End If
Ορισμός WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
Για xRowIndex = xLastRow To 1 Step -1
Ορισμός Rng = WorkRng.Range("A" & xRowIndex)
Εάν Rng.Value = "0" τότε
Rng.Offset(1, 0).Αλλαγή μεγέθους(xInsertNum).EntireRow.Insert Shift:=xlDown
End If
Επόμενο
Application.ScreenUpdating = True
Sub End

Το παρακάτω είναι να εισαγάγετε σειρές από πάνω.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Sunny, αυτή η μακροεντολή λειτουργεί τέλεια για μένα. Απλώς έπρεπε να αλλάξω την ποσότητα των σειρών σε 30 και να αλλάξω το 0 σε κείμενο: "Κλείσιμο υπόλοιπο". Αλλά τώρα θέλω να κάνω αντιγραφή και επικόλληση μιας επιλογής κελιών που έχει ύψος 30 σειρές στις 30 κενές γραμμές που μόλις εισήχθησαν από αυτήν τη μακροεντολή. Μπορείτε να προτείνετε μια νέα μακροεντολή (ή μια τροποποίηση σε αυτήν) για να αντιγράψετε και να επικολλήσετε μια περιοχή σε κάθε γραμμή 30 κενών. Ονόμασα το εύρος αντιγραφής και επικόλλησης "πρότυπο".
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χρειάζομαι τεράστια βοήθεια σε αυτό το θέμα. Έχω 2 στήλες, την 1η έχω τα δεδομένα μου ώρα 01/01/2016 05:00:00, ημέρες/μήνες/έτος ώρα/λεπτά/δευτερόλεπτα και στη 2 2η στήλη τα αντίστοιχα στοιχεία που σχετίζονται με την ώρα.

Το πρόβλημά μου είναι ότι θέλω να προσθέσω χρόνο δεδομένων μεταξύ των σειρών, καθώς έχω κενά ημερών. Η 1η γραμμή είναι 01/01/2016 και η 2η σειρά έχει, για παράδειγμα, 10/01/2016, οπότε έχω 9 ημέρες. και αυτός ο κωδικός δεν λειτουργεί για μένα.

Ανυπομονώ να λάβω σχόλια, παρακαλώ! Ευχαριστώ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μπορείτε να δοκιμάσετε αυτό το VBA

SubInsertValueBetween()
«Ενημέρωση 20130825
Dim WorkRng As Range
Dim Rng ως εμβέλεια
Dim outArr As Variant
Dim dic As Variant
Ορισμός dic = CreateObject ("Scripting.Dictionary")
'On Error Συνέχιση Επόμενο
xTitleId = "KutoolsforExcel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
num1 = WorkRng.Range("A1").Τιμή
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Τιμή
διάστημα = num2 - num1
ReDim outArr(1 σε διάστημα + 1, 1 έως 2)
Για κάθε Rng στο WorkRng
dic(Rng.Value) = Rng.Offset(0, 1).Value
Επόμενο
Για i = 0 Σε διάστημα
outArr(i + 1, 1) = i + num1
Αν dic.Exists(i + num1) Τότε
outArr(i + 1, 2) = dic(i + num1)
Αλλού
outArr(i + 1, 2) = ""
End If
Επόμενο
Με WorkRng.Range("A1").Αλλαγή μεγέθους(UBound(outArr, 1), UBound(outArr, 2))
.Τιμή = outArr
.Επιλέγω
Τέλος με
Sub End


Ή αν έχετε Kutools για Excel, μπορείτε να δοκιμάσετε αυτήν τη λειτουργία:
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ, έχω δοκιμάσει και τα δύο, το 1ο αφού έχω περίπου 500 σειρές δεδομένων, το κάνω και για τις 500 σειρές και δεν κάνει τίποτα, νομίζω ότι ίσως έχει περιορισμό στις σειρές που θα χρησιμοποιήσω, και όταν επιλέγω μόνο τις πρώτες 5 σειρές, για παράδειγμα, δεν δημιουργεί τις σειρές που λείπουν, αντικαθιστά τις σειρές για τα δεδομένα που λείπουν.

Ένα άλλο πρόβλημα που έχω είναι ότι τα δεδομένα ώρας μου έχουν επίσης την Ημέρα/Μήνα/Έτος ΩΩ: ΜΜ: SS
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Από το 2 έως το 3, δημιουργεί τα στοιχεία που λείπουν που θέλω εντάξει, αλλά η τιμή της 03/01/2016 καταργείται και υπάρχουν κάποια χρονικά δεδομένα που εξαλείφονται κάτι που ούτε εγώ θέλω
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δυστυχώς ο κώδικας VBA δεν σας βοήθησε, δεν μπορώ να βρω τη μέθοδο που μπορεί να λειτουργήσει για τη μορφή ημερομηνίας και ώρας. Εάν τελικά βρείτε τη λύση, θα μπορούσατε να με ενημερώσετε; Σας ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια και πάλι Sunny, κατάφερα να επεξεργαστώ τον κωδικό σε αυτό (αλλάξω τη γραμμή num1 σε A2 και With WorkRng.Range("A2:A100000"). Αλλαγή μεγέθους(UBound(outArr, 1), UBound(outArr, 2) ):


SubInsertValueBetween()
«Ενημέρωση 20130825
Dim WorkRng As Range
Dim Rng ως εμβέλεια
Dim outArr As Variant
Dim dic As Variant
Ορισμός dic = CreateObject ("Scripting.Dictionary")
'On Error Συνέχιση Επόμενο
xTitleId = "KutoolsforExcel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
num1 = WorkRng.Range("A2").Τιμή
num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Τιμή
διάστημα = num2 - num1
ReDim outArr(1 σε διάστημα + 1, 1 έως 2)
Για κάθε Rng στο WorkRng
dic(Rng.Value) = Rng.Offset(0, 1).Value
Επόμενο
Για i = 0 Σε διάστημα
outArr(i + 1, 1) = i + num1
Αν dic.Exists(i + num1) Τότε
outArr(i + 1, 2) = dic(i + num1)
Αλλού
outArr(i + 1, 2) = ""
End If
Επόμενο
Με WorkRng.Range("A2:A100000").Αλλαγή μεγέθους(UBound(outArr, 1), UBound(outArr, 2))
.Τιμή = outArr
.Επιλέγω
Τέλος με
Sub End



Σας δείχνω τα γραφήματα, δεν λειτουργεί 100% γιατί δεν δημιουργεί το χρόνο από το Α1 στο Α2
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτή είναι η ερώτησή μου και είναι πολύ δύσκολη υποθέτω.. υπάρχει κώδικας vba που προσθέτει μια νέα σειρά κάτω από μια φιλτραρισμένη στήλη και αντιγράφει μόνο τα τρία πρώτα κελιά στη νέα γραμμή που προστέθηκε και συνεχίζει να το κάνει μέχρι ο χρήστης να σταματήσει να χτυπά "Εισαγωγή" και κατάργηση φιλτραρίσματος των φιλτραρισμένων κελιών;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Η ερώτησή σας είναι κάπως δύσκολη και σύνθετη, μπορείτε να την βάλετε στο φόρουμ μας, ίσως κάποιος να σας απαντήσει. https://www.extendoffice.com/forum.html
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, θέλω απλώς να ρωτήσω πώς να προσθέσω σειρά εάν η συνθήκη είναι ότι η προσθήκη σειράς πρέπει να γίνει όταν ένα κελί έχει ήδη δεδομένα (Είναι για ένα βιβλίο εργασίας excel με πολλά φύλλα :) Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
ίσως αυτός ο κώδικας vba μπορεί να σας βοηθήσει. Θα προσθέσει σειρές εάν η παραπάνω σειρά δεν είναι κενή

Υποβοήθεια ()
Αχνό μέτρημα όσο καιρό
Για count = ActiveSheet.UsedRange.Rows.count To 1 Step -1
Αν Information.IsEmpty(Cells(count, 1)) = False then Rows(count + 1).Insert
Επόμενη καταμέτρηση
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, προσπαθώ να χρησιμοποιήσω αυτόν τον κωδικό για να εισαγάγω μια σειρά όταν αλλάζουν τα πρώτα 4 ψηφία σε ένα κελί (αν είναι ακόμη δυνατό)

για παράδειγμα,
2222A
2222B
2223K


η γραμμή θα εισαχθεί μετά το 2222B καθώς ο 3ος αριθμός είναι 3 και όχι 2

Ευχαριστώ παιδιά!!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Ευχαριστώ για αυτό, ωστόσο έχω ένα άλλο σενάριο όπου πρέπει να εισαγάγω ένα κελί cingle κάτω από την τιμή που δεν είναι μηδέν. Εκτιμήστε οποιαδήποτε πρόταση.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Τζίνα, μόλις βρήκα τον κωδικό για να εισαγάγω κενή σειρά πάνω από το κελί που δεν είναι κενό, ίσως κάποιος μπορεί να τον προσαρμόσει για να καλύψει τις ανάγκες σας.

SubInsert_Rows()
Dim LR As Long, r As Long

Application.ScreenUpdating = False
LR = Εύρος ("A" & Γραμμές.Αριθμός).Τέλος(xlUp).Σειρά
Για r = LR Προς 1 Βήμα -1
Αν Len(Range("A" & r).Value) > 0 Τότε
Γραμμές(r).Εισαγωγή
End If
Επόμενο r
Application.ScreenUpdating = True
Sub End

προέρχομαι https://www.mrexcel.com/forum/excel-questions/548675-adding-blank-line-above-row-non-blank-cell.html
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, αυτό είναι πολύ χρήσιμο. Τι θα γινόταν αν ήθελα να προσθέσω δύο γραμμές παρακάτω και ήθελα περισσότερες τιμές. Για παράδειγμα, θέλω να προσθέσω δύο γραμμές μετά την τιμή 26/04/2019 και μετά δύο γραμμές μετά τις 03/04/2019 και η λίστα συνεχίζεται. Πώς μπορώ να συνεχίσω να προσθέτω στο vba; Συγγνώμη, είμαι ακόμα αρχάριος. Ευχαριστώ εκ των προτέρων.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Safa, ίσως μπορείτε να δοκιμάσετε το βοηθητικό πρόγραμμα εισαγωγής κενών γραμμών/στηλών του Kutools.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Sub BlankLine()
«Ενημέρωση έως το 20150203
Dim Rng ως εμβέλεια
Dim WorkRng As Range
On Error Συνέχιση Επόμενη
xTitleId = "KutoolsforExcel"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Τύπος: = 8)
Ορισμός WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
Για xRowIndex = xLastRow To 1 Step - 1
Ορισμός Rng = WorkRng.Range("A" & xRowIndex)
Εάν Rng.Value = "0" τότε
Rng.EntireRow.Insert Shift: = xlDown
End If
Επόμενο
Application.ScreenUpdating = True
Sub End


Χρειάζομαι αυτό για να λειτουργεί κάθε φορά που βάζω κάτι στο κελί, καθώς και με περισσότερες μεταβλητές. Αυτό που εννοώ είναι ότι αν βάλω 2 στο κελί, το χρειάζομαι για να εισάγω 2 σειρές και όχι μόνο 1.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χρειάζομαι τη μακροεντολή για να προσθέσω σειρές με βάση μια στήλη ποσότητας όπου αν το ποσό είναι μεγαλύτερο από 1, εισάγει τον αριθμό των σειρών -1. Εάν η ποσότητα είναι 5, εισάγει 4 σειρές από κάτω και συμπληρώνει τα δεδομένα και αλλάζει την ποσότητα που καλείται από 5 σε 1 κάθε σειρά. Παράλειψη όλων των ποσοτήτων 1.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πείτε μου τον κωδικό όπου θέλω να προσθέσω έναν συγκεκριμένο αριθμό σειρών με βάση μια τιμή κελιού. για παράδειγμα, εάν το κελί περιέχει το ψηφίο 18, αυτόματα θα πρέπει να προστεθούν 18 σειρές όπου θέλω και το υπόλοιπο του πίνακα/κελί θα πρέπει να μετακινηθεί προς τα κάτω.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ πολύ για αυτό, πραγματικά μια τεράστια εξοικονόμηση χρόνου. Θα ήταν δυνατό να προσθέσω κάποιον κώδικα που να μου επιτρέπει να εισάγω κάποιο κείμενο στη νέα σειρά; Για παράδειγμα, εισάγω νέες σειρές με βάση την τιμή στόχο "x" και μετά θέλω να προσθέσω την τιμή κειμένου "y" στο κελί κάτω από την τιμή στόχο "x". Είναι δυνατόν;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας. Η μακροεντολή λειτουργεί για μένα, αλλά υπάρχει τρόπος να ορίζονται πάντα το εύρος/παράμετροι στη στήλη J χωρίς να εμφανίζεται καθόλου το πλαίσιο εισαγωγής; Θα ήθελα να παραλείψει το βήμα του πλαισίου εισαγωγής που εμφανίζεται. Επίσης, έχω βεβαιωθεί ότι ακριβώς πριν από αυτήν τη μακροεντολή η τελευταία γραμμή της προηγούμενης μακροεντολής μου είναι Εύρος ("J:J"). Επιλέξτε για να βεβαιωθείτε ότι ολόκληρη η στήλη J είναι ήδη επιλεγμένη.
Αυτό χρησιμοποιούσα μέχρι τώρα.

Dim Rng ως εμβέλεια
Dim WorkRng As Range
On Error Συνέχιση Επόμενη
xTitleId = "Κάντε κλικ στο OK για να συνεχίσετε"
Ορισμός WorkRng = Application.Selection
Ορισμός WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Ορισμός WorkRng = WorkRng.Columns(1)
SendKeys "~"
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
Για xRowIndex = xLastRow To 1 Step -1
Ορισμός Rng = WorkRng.Range("A" & xRowIndex)
Εάν Rng.Value = "Νέα γραμμή GMS" Τότε
Rng.EntireRow.Insert Shift:=xlDown
End If
Επόμενο


Δοκίμασα να πειραματιστώ χρησιμοποιώντας την εντολή SendKeys "~" ανάμεσα σε μερικά από τα βήματα για να προσπαθήσω να πατήσω αυτόματα το enter όταν εμφανιστεί το πλαίσιο εισαγωγής, αλλά ούτε αυτό λειτούργησε. Δεν ήξερα πού ακριβώς να χρησιμοποιήσω την εντολή SendKeys στη μακροεντολή ή αν θα λειτουργούσε ακόμη και με ένα πλαίσιο εισόδου!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
παρακαλώ βοηθήστε με να έχω δεδομένα. Έχω δεδομένα χρόνου ενός μήνα, δηλαδή πρέπει να εισαγάγω κενές σειρές ανάλογα με τον χρόνο διαφυγής
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, hr.babu08, συγγνώμη που η απάντηση άργησε. Υποθέτω ότι θέλετε να εισαγάγετε κενές σειρές ή να κάνετε ένα σημάδι για τα δεδομένα ακολουθίας που λείπουν, εάν ναι, μπορείτε να δοκιμάσετε το Kutools για τη λειτουργία Εύρεσης αριθμού ακολουθίας που λείπει του Excel. Εδώ είναι το σεμινάριο σχετικά με τη δυνατότητα: https://www.extendoffice.com/product/kutools-for-excel/excel-find-missing-numbers-in-sequence.htmlIf θέλετε άλλες μεθόδους για την εισαγωγή κενών σειρών για ακολουθία που λείπει, επισκεφτείτε:https://www.extendoffice.com/documents/excel/3522-excel-find-missing-dates.html</div>;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Μπορεί αυτό το marco να χρησιμοποιηθεί/αλλαγεί για έγχρωμα κελιά;
Πρέπει να εισάγω τουλάχιστον 10 σειρές πάνω από το τέλος κάθε σειράς που είναι χρωματιστές.
Thx!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πρέπει να προσθέσω συγκεκριμένες σειρές με τιμές σε αυτές για συγκεκριμένα περιεχόμενα κελιών, αλλά δεν είμαι σίγουρος πώς να το κάνω χωρίς να χρειάζεται να κάνω με μη αυτόματο τρόπο για περισσότερες από 3800 γραμμές

Π.χ.: A1 = Node1
Πρέπει να εισαγάγω μια σειρά και να εισαγάγει την τιμή Scanner
Εισαγάγετε μια άλλη σειρά και πληκτρολογήστε την τιμή Printer
άλλη μια σειρά με τιμή CD.
Κ.λπ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Chris, εδώ είναι ένα VBA που μπορεί να σας βοηθήσει να εισάγετε αυτόματα τρεις σειρές (Scanner, Printer, CD) όταν η τιμή είναι ίση με Node1.
Sub BlankLine()
'ByExtendoffice
Dim Rng As Range

Dim WorkRng As Range

Dim xRngI As Range

On Error Resume Next

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Select a range", xTitleId, WorkRng.Address, Type:=8)

Set WorkRng = WorkRng.Columns(1)

xLastRow = WorkRng.Rows.Count

Application.ScreenUpdating = False

For xRowIndex = xLastRow To 1 Step -1

  Set Rng = WorkRng.Range("A" & xRowIndex)

  If Rng.Value = "Node1" Then

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown

    Rng.Offset(1, 0).Value = "Scanner"

    Rng.Offset(2, 0).Value = "Printer"

    Rng.Offset(3, 0).Value = "CD"

  End If

Next

Application.ScreenUpdating = True

End Sub

Παρακαλώ ενημερώστε με εάν λειτουργεί για εσάς.
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

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

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