Κλείσιμο
Κλείσιμο
Αρχική » Business Intelligence » Microsoft Excel » Χρήσιμες VBA ρουτίνες στο Microsoft Excel (Part 2)

Χρήσιμες VBA ρουτίνες στο Microsoft Excel (Part 2)

Χρήσιμες VBA ρουτίνες στο Microsoft Excel (Part 2)
, , , Αφήστε ένα σχόλιο
Χρήσιμες VBA ρουτίνες στο Microsoft Excel (Part 2)
Τελευταίες δημοσιεύσεις από Stratos Matzouranis (Προβολή όλων)

Σε συνέχεια του προηγούμενου άρθρου θα δούμε μερικές ακόμα ρουτίνες VBA (Visual Basic for Applications) που έχουμε τη δυνατότητα να χρησιμοποιήσουμε στο Microsoft Excel.

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

Διαγραφή όσων γραμμών έχουν κενό ένα κελί

Με τη παρακάτω ρουτίνα μπορούμε να διαγράψουμε όσες γραμμές έχουν κενό το κελί σε μια συγκεκριμένη στήλη. Π.χ. Η στήλη “Α” στο φύλλο “sheet1”:

Sub DeleteERowsOther()

    Sheets("sheet1").Select
    Range("A3:A1000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

Εκτέλεση εντολών cmd (command prompt) / Putty μέσω του Excel

Με την παρακάτω ρουτίνα έχουμε τη δυνατότητα να εκτελέσουμε κάποιο αρχείο με εντολές ή να τρέξουμε απευθείας εντολές. Στο παράδειγμα καλούμε το plink.cmd(Putty) και μετά καλούμε να αποθηκεύσουμε ένα ping του Google σε έναν φάκελο. Με την παράμετρο /k μετά την εκτέλεση το παράθυρο θα παραμείνει ανοιχτό:

Sub callcmd()

Application.DisplayAlerts = False
Dim FileName As String

FileName = ActiveWorkbook.Path & "\plink.cmd /c "  'gia ektelesi etoimou arxeiou
Shell FileName

Shell "cmd.exe /c ping google.com" & " && cd\Users\Username\Desktop" & " &&mkdir tester"   'gia apeutheias cmd commands
'me /k  to parathiro cmd den tha kleisei

 Application.DisplayAlerts = True
End Sub

Άμεση εκτέλεση αρχείου cmd (command prompt) μέσω του Excel

Μια πιο απλή προσέγγιση της προηγούμενης ρουτίνας για άμεση εκτέλεση ενός έτοιμου cmd αρχείου. Απλά θα πρέπει να βρίσκεται το αρχείο στο ίδιο path με το Excel και το μόνο που πρέπει να παραμετροποίησουμε είναι το όνομά στη παράμετρο shellCommand:

Sub runbat()

Application.DisplayAlerts = False
Dim folderPath As String
Dim shellCommand As String

folderPath = Application.ActiveWorkbook.Path

shellCommand = """" & folderPath & "\" & "Arxeio.bat" & """"

Call Shell(shellCommand, vbNormalFocus)
End Sub

Εισαγωγή αρχείου κειμένου στα κελιά του Excel

Με την παρακάτω ρουτίνα μπορούμε να εισάγουμε ένα αρχείο txt σε ένα φύλλο του Excel.

Οι παράμετροι:

  • Filename:= ορίζουμε το όνομα του αρχείου.
  • Set wsI = wbI.Sheets(“…”) το όνομα του φύλλου που θα τοποθετηθούν τα δεδομένα.
  • Set wbO = Workbooks.Open(FileName, Format:=3) τι delimiter (διαχωριστή) θα χρησιμοποιήσουμε με 3 είναι space και με 4 είναι semicolon.

Sub importtxt()

   Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet
    Dim FileName As String
    FileName = ActiveWorkbook.Path & "\apotelesmata.txt"
    Set wbI = ThisWorkbook
    Set wsI = wbI.Sheets("apotelesmata") '<~~ To fyllo p tha topothetithoun
    wsI.Range("A1:AT1000").Clear
        '3 = space 4 = semicolon
    Set wbO = Workbooks.Open(FileName, Format:=3)
    wbO.Sheets(1).Cells.Copy wsI.Cells
wbO.Close SaveChanges:=False

End Sub

Παγώμα εκτέλεσης των επόμενων ρουτινών για χ χρόνο

Με την παρακάτω ρουτίνα μπορούμε να παγώσουμε την εκτέλεση των επόμενων ρουτινών για χ χρόνο. Μπορεί να θέλουμε ένα εύλογο χρονικό διάστημα ώστε να ολοκληρωθεί η προηγούμενη. Π.χ. όπως στο παράδειγμα 30 δευτερόλεπτα:

Sub WaitTimer()

 Application.DisplayAlerts = False

Application.Wait (Now + TimeValue("0:00:30"))

Application.DisplayAlerts = True
End Sub

Διαγραφή γραμμών που έχουμε κενή τιμή σε κάποια στήλη

Έχουμε δει παρόμοια ρουτίνα που λειτουργεί όταν σε μια στήλη έχουμε μια συγκεκριμένη τιμή. Η παρακάτω ρουτίνα έχει φτιαχτεί για την περίπτωση που η τιμή είναι κενή

Οι παράμετροι:

  • Sheets(“…”).Select ορίζουμε το φίλο που μας αφορά.
  • Set InputRng = Range(….) ορίζουμε που θα βρίσκεται η τιμή που θέλουμε να ελέγξουμε.
  • DeleteStr ορίζουμε την τιμή που ψάχνουμε.

Sub deleteifcolumnisEmpty()

Application.DisplayAlerts = False
Sheets("sheet1").Select
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String
Set InputRng = Range("g1", "g10000")

For Each rng In InputRng
    If Len(rng.Value) = 0 Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rng
        Else
            Set DeleteRng = Application.Union(DeleteRng, rng)
     End If
    End If
Next

DeleteRng.EntireRow.Delete
Application.DisplayAlerts = True
End Sub

Αντιγραφή σε δεδομένων από ένα φύλλο σε ένα άλλο

Με τη παρακάτω ρουτίνα μπορούμε να αντιγράψουμε τα δεδομένα από ένα φύλλο σε ένα άλλο και έπειτα να διαγράψουμε το αρχικό φύλλο:

Sub copyToanotherSheet()

Application.DisplayAlerts = False
Worksheets("TEMP_sheet").Range("A1:AA10000").Copy Destination:=Worksheets("sheet").Range("A5:AA10005")
Worksheets("TEMP_sheet").Delete

Application.DisplayAlerts = True
End Sub

Σύγκρισή δύο τιμών και εμφάνιση pop-up παραθύρου

Μπορούμε να συγκρίνουμε τιμές και αν δεν πληρεί τις προϋποθέσεις να εμφανιστεί pop-up παράθυρο με κάποιο μήνυμα.

Οι παράμετροι:

  • Set Rng1 = Range(“…”) καλούμε την τιμή του κελιού.
  • Value ορίζουμε την τιμή που ελέγχουμε αν ισχύει.
  • Prompt ορίζουμε το κείμενο στο παράθυρο.
  • Title ορίζουμε τον τίτλο του παραθύρου.

Sub Worksheet_Calculate()

Dim Rng1            As Range
Dim Value           As String
Dim Prompt          As String
Dim Title           As String

    Set Rng1 = Range("B1")
    Value = "Swsto"
    Prompt = "Lathos Katametrisi"
    Title = "Error"

    If Rng1.Value = Value Then
        MsgBox Prompt, vbInformation, Title
        End
    End If

End Sub

Πώς εκτελούνται

Όπως αναφέραμε και στο πρώτο μέρος όταν θα έχουμε τον κώδικα περασμένο στο Excel, τις καλούμε προσθέτοντας στον κώδικα κάποιο event π.χ. κατά το άνοιγμα του Excel ή τις καλούμε μέσα από τον κώδικα ενός κουμπιού όταν το κάνουμε κλικ.

Μοιράσου το

Αφήστε μία απάντηση