seychellesartprojects.org

Παραδείγματα Excel VBA για αρχάριους

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

Λίστα των κορυφαίων 19 παραδειγμάτων

1. Εκτύπωση όλων των ονομάτων φύλλων
2. Εισαγωγή διαφορετικού δείκτη χρώματος στο VBA
3. Εισαγωγή σειριακού αριθμού από την κορυφή
4. Εισαγωγή σειριακού αριθμού από κάτω
5. Εισαγωγή σειριακού αριθμού από 10 έως 1
6. Εισαγάγετε φύλλα εργασίας όσο θέλετε
7. Διαγραφή όλων των κενών φύλλων εργασίας από το βιβλίο εργασίας
8. Εισαγωγή κενής σειράς μετά από κάθε άλλη σειρά
9. Επισήμανση λάθους ορθογραφίας
10. Αλλαγή όλων σε κεφαλαίους χαρακτήρες
11. Αλλαγή όλων σε πεζούς χαρακτήρες
12. Επισημάνετε όλα τα κελιά που σχολιάστηκαν
13. Επισημάνετε όλα τα κενά κελιά
14. Απόκρυψη όλων των φύλλων εκτός από ένα φύλλο
15. Αποκρύψτε όλα τα φύλλα
16. Διαγραφή όλων των αρχείων στο φάκελο
17. Διαγραφή ολόκληρου του φακέλου
18. Βρείτε τη σειρά που χρησιμοποιήθηκε τελευταία στο φύλλο
19. Βρείτε τη στήλη που χρησιμοποιήθηκε τελευταία στο φύλλο

Ας δούμε κάθε ένα από αυτά τα παραδείγματα λεπτομερώς.

Μπορείτε να κατεβάσετε αυτό το Πρότυπο VBA Παραδείγματα Excel εδώ - Πρότυπο VBA Παραδείγματα Excel

# 1 - Εκτύπωση όλων των ονομάτων φύλλων

Κώδικας:

 Sub Print_Sheet_Names () Dim i As Integer For i = 1 To Sheets.Count Cells (i, 1). Value = Sheets (i) .Name Next i End Sub 

Αυτό θα εξαγάγει όλα τα ονόματα φύλλων στο ενεργό φύλλο.

# 2 - Εισαγωγή διαφορετικού δείκτη χρώματος στο VBA

Κώδικας:

 Sub Insert_Different_Colours () Dim i As Integer For i = 1 to 56 Cells (i, 1). Value = i Cells (i, 2). Interior.ColorIndex = i Next End Sub 

Αυτό θα εισαγάγει αριθμούς από το 1 έως το 56 και τον δείκτη χρωμάτων τους στην επόμενη στήλη.

# 3 - Εισαγωγή σειριακού αριθμού από την κορυφή

Κώδικας:

 Sub Insert_Numbers_From_Top () Dim i As Integer For i = 1 to 10 Cells (i, 1). Value = i Next i End Sub 

Αυτό θα εισαγάγει σειριακούς αριθμούς από 1 έως 10 από την κορυφή.

# 4 - Εισαγωγή σειριακού αριθμού από κάτω

Κώδικας:

 Sub Insert_Numbers_From_Bottom () Dim i As Integer For i = 20 to 1 Step -1 Cells (i, 7). Value = i Next i End Sub 

Αυτό θα εισαγάγει σειριακούς αριθμούς από 1 έως 20 από το κάτω μέρος.

# 5 - Εισαγωγή σειριακού αριθμού από 10 έως 1

Κώδικας:

 Sub Ten_To_One () Dim i As Integer Dim j As Integer j = 10 For i = 1 to 10 Range ("A" & i). Value = jj = j - 1 Next i End Sub 

Αυτό θα εισαγάγει σειριακούς αριθμούς από 10 έως 1 από την κορυφή.

# 6 - Εισαγάγετε φύλλα εργασίας όσο θέλετε

Κώδικας:

 Sub AddSheets () Dim ShtCount As Integer, i As Integer ShtCount = Application.InputBox ("Πόσα φύλλα θέλετε να εισαγάγετε;", "Add Sheets",,,,,, 1) Εάν ShtCount = False τότε Exit Sub Else Για i = 1 Σε φύλλα εργασίας ShtCount. Προσθήκη Επόμενου i End if End Sub 

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

# 7 - Διαγραφή όλων των κενών φύλλων εργασίας από το βιβλίο εργασίας

Κώδικας:

 Sub Delete_Blank_Sheets () Dim ws As Application Sheet Application.DisplayAlerts = False Application.ScreenUpdating = False For Every ws In ActiveWorkbook.Worksheets If WorksheetFunction.CountA (ws.UsedRange) = 0 Τότε ws.Deteete End if Next ws Application.DisplayAlerts = True Application .ScreenUpdating = Υπολογισμός True End 

Αυτό θα διαγράψει όλα τα κενά φύλλα εργασίας από το βιβλίο εργασίας που επεξεργαζόμαστε.

# 8 - Εισαγάγετε την κενή σειρά μετά από κάθε άλλη σειρά

Κώδικας:

 Sub Insert_Row_After_Every_Other_Row () Dim rng As Range Dim CountRow As Integer Dim i As Integer Set rng = Selection CountRow = rng.EntireRow.Count For i = 1 To CountRow ActiveCell.EntireRow.Insert ActiveCell.Offset (2, 0). Τέλος Υποτ 

Για αυτό πρώτα, πρέπει να επιλέξετε το εύρος όπου θέλετε να εισαγάγετε εναλλακτικές κενές γραμμές

# 9 - Επισήμανση ορθογραφικού λάθους

Κώδικας:

 Sub Chech_Spelling_Mistake () Dim MySelection ως εύρος για κάθε MySelection στο ActiveSheet.UsedRange if Not Application.CheckSpelling (Word: = MySelection.Text) Έπειτα MySelection.Interior.Color = vbRed End if Next MySelection End Sub 

Αρχικά, επιλέξτε τα δεδομένα και εκτελέστε τον κωδικό VBA. Θα επισημάνει τα κελιά που έχουν ορθογραφικά λάθη.

# 10 - Αλλαγή όλων σε κεφαλαίους χαρακτήρες

Κώδικας:

 Sub Change_All_To_UPPER_Case () Dim Rng ως εύρος για κάθε Rng σε επιλογή. Κελιά Εάν Rng.HasFormula = False Then Rng.Value = UCase (Rng.Value) End if Next Rng End Sub 

Αρχικά, επιλέξτε τα δεδομένα και εκτελέστε τον κωδικό. Θα μετατρέψει όλες τις τιμές κειμένου σε κεφαλαίους χαρακτήρες.

# 11 - Αλλαγή όλων σε πεζούς χαρακτήρες

Κώδικας:

 Sub Change_All_To_LOWER_Case () Dim Rng ως εύρος για κάθε Rng σε επιλογή. Κελιά Εάν Rng.HasFormula = False Then Rng.Value = LCase (Rng.Value) End if Next Rng End Sub 

Αρχικά, επιλέξτε τα δεδομένα και εκτελέστε τον κωδικό. Θα μετατρέψει όλες τις τιμές κειμένου σε πεζούς χαρακτήρες στο Excel.

# 12 - Επισημάνετε όλα τα κελιά που σχολιάστηκαν

Κώδικας:

 Sub HighlightCellsWithCommentsInActiveWorksheet () ActiveSheet.UsedRange.SpecialCells (xlCellTypeComments). Εσωτερικό.ColorIndex = 4 End Sub 

Αποτέλεσμα: 

# 13 - Επισημάνετε όλα τα κενά κελιά

Κώδικας:

 Sub Highlight_Blank_Cells () Dim DataSet As Range Set DataSet = Selection DataSet.Cells.SpecialCells (xlCellTypeBlanks). Εσωτερικό.Color = vbGreen End Sub 

Αρχικά, επιλέξτε το εύρος δεδομένων και εκτελέστε τον κωδικό. Θα επισημάνει όλα τα κενά κελιά με πράσινο χρώμα.

# 14 - Απόκρυψη όλων των φύλλων εκτός από ένα φύλλο

Κώδικας:

 Sub Hide_All_Except_One () Dim Ws ως φύλλο εργασίας για κάθε Ws στο ActiveWorkbook.Wheheets If Ws.Name "Main Sheet" Στη συνέχεια Ws.Visible = xlSheetVeryHidden Next Ws End Sub 

Ο παραπάνω κωδικός κρύβει όλα τα φύλλα εκτός από το φύλλο που ονομάζεται "Κύριο φύλλο". Μπορείτε να αλλάξετε το όνομα του φύλλου εργασίας σύμφωνα με την επιθυμία σας.

# 15 - Απόκρυψη όλων των φύλλων

Κώδικας:

 Sub UnHide_All () Dim Ws ως φύλλο εργασίας για κάθε Ws στο ActiveWorkbook. Φύλλα εργασίας Ws.Visible = xlSheetVisible Next Ws End Sub 

Αυτό θα εμφανίσει όλα τα κρυμμένα φύλλα.

# 16 - Διαγραφή όλων των αρχείων στο φάκελο

Κώδικας:

 Sub Delete_All_Files () 'Μπορείτε να το χρησιμοποιήσετε για να διαγράψετε όλα τα αρχεία στο φάκελο Test' 'On Error Resume Next Kill "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \ *. *" On Error GoTo 0 Τέλος Υποτ 

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

# 17 - Διαγραφή ολόκληρου του φακέλου

Κώδικας:

 Sub Delete_Whole_Folder () 'Μπορείτε να το χρησιμοποιήσετε για να διαγράψετε ολόκληρο το φάκελο On Error Resume Next Kill "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \ *. *"' Πρώτον θα διαγράψει όλα τα αρχεία του φακέλου 'Στη συνέχεια, ο παρακάτω κώδικας θα διαγράψει ολόκληρο το φάκελο εάν είναι κενό RmDir "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \"' Σημείωση: Το RmDir διαγράφει μόνο έναν κενό φάκελο Σφάλμα GoTo 0 End Sub 

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

# 18 - Βρείτε τη σειρά που χρησιμοποιήθηκε τελευταία στο φύλλο

Κώδικας:

 Sub Last_Row () Dim LR As Long LR = Cells (Rows.Count, 1). End (xlUp). Row MsgBox LR End Sub 

Εδώ βρίσκουμε τη σειρά που χρησιμοποιήθηκε τελευταία στο φύλλο

# 19 - Βρείτε τη στήλη που χρησιμοποιήθηκε τελευταία στο φύλλο

Κώδικας:

 Sub Last_Column () Dim LC As Long LC = Cells (1, Columns.Count). End (xlToLeft). Column MsgBox LC End Sub 

Εδώ βρίσκουμε τη στήλη που χρησιμοποιήθηκε τελευταία στο φύλλο