Macro Xls (VB)

VB Script και κολπάκια, Excel macro, Word, Powerpoint, κτλ

Συντονιστές: WebDev Moderators, Super-Moderators

Απάντηση
NikosJC
Δημοσιεύσεις: 9
Εγγραφή: 27 Οκτ 2007 19:05

Macro Xls (VB)

Δημοσίευση από NikosJC » 11 Μαρ 2011 19:17

Ρε παιδιά μια βοήθεια όποιος μπορεί:

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

...........Α................................Β..............................C
Ανταλλακτικά.................. Έργο 1.................. Έργο 2 .... (άγνωστος αριθμός έργων κάθε φορά)
Ανταλλακτικό 1................ 5.................................7
Ανταλλακτικό 2................ 0.................................3
Ανταλλακτικό 3................ 3.................................9

Θέλω η μακροεντολή να φτιάχνει ένα νέο φύλλο για κάθε έργο (1,2,3 και όσα υπάρχουν) που θα περιέχει την πρώτη στήλη (Α) στην αντίστοιχη στήλη Α του νέου φύλλου και την αντίστοιχη στήλη (αναλόγως το έργο Β,C,D,κλπ) στη στήλη Β του νέου φύλλου. Ταυτόχρονα θα ονοματίζει και το φύλλο με το όνομα του έργου.

Μέχρι στιγμής έχω καταφέρει κάποια (δημιουργία νέου φύλλου, ονομασία του με το έργο 1, αντιγραφή των στηλών που θέλω στο νέο φύλλο "έργο 1"). Το πρόβλημα μου είναι η επιλογή της επόμενης στήλης για αντιγραφή (έργο 2, μετά έργο 3, κλπ) και ο έλεγχος να σταματάει όταν φτάνει σε κενή στήλη.

Όποιος μπορεί να βοηθήσει...

Στο παράδειγμα η σταθερή στήλη μου είναι η Β και η πρώτη από τις μεταβαλλόμενες είναι η G και τις αντιγράφει πάντα στην C και H κάθε νέου φύλλου. Θέλω μια ρουτίνα που να αλλάζει το G σε H, I, J, κλπ κάνοντας έλεγχο μεχρι το πρώτο κελί κάποιας στήλης να μην έχει τιμή.


' Εισαγωγή νέου φύλλου
Sheets.Add After:=Sheets(1)
Sheets(1).Select

' Νεό φύλλο
' Ονομασία νέου φύλλου από πρώτο επιλεγμένο κελί (πχ έργο 1)
Range("G1").Select
Sheets(2).Name = ActiveCell.Value

' Αντιγραφές στηλών
Sheets(1).Select
Range("B2:B500").Select
Selection.Copy
Sheets(2).Select
Range("C1").Select
ActiveSheet.Paste

Sheets(1).Select
Range("G2:G500").Select
Selection.Copy
Sheets(2).Select
Range("H1").Select
ActiveSheet.Paste


Ένα 2ο που θα με ενδιέφερε, είναι όταν παίρνει την στήλη Β και την στηλή (G ή Η ή I, κλπ) να ελέγχει αν η 2η στήλη έχει τιμή 0 και να σβήνει το ανταλλακτικό. (Αυτό δεν πρέπει να είναι δύσκολο, κάποια στιγμή το είχα βρει, αλλά δεν το θυμάμαι).

Ευχαριστώ!

Άβαταρ μέλους
zefremi
Δημοσιεύσεις: 27
Εγγραφή: 11 Μαρ 2004 16:15

Macro Xls (VB)

Δημοσίευση από zefremi » 12 Μαρ 2011 02:42

Μπορείς να χρησιμοποιήσεις την επαναληπτική δομή while και να κρατάς σε μεταβλητές τις γραμμές και στήλες που θέλεις να αναφέρεσαι.

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

Κώδικας: Επιλογή όλων

Sub ColumnsToSheets()
    Dim s, ia, ib, j As Integer
    Dim temp As Variant
    
    ' Φύλλο 2, Στήλη G
    s = 2
    j = 7
    
    ' Όσο δεν είναι κενό το πρώτο κελί της στήλης j επαναλαμβάνει
    While Worksheets&#40;1&#41;.Cells&#40;1, j&#41; <> ""
    
        ' Εισαγωγή νέου φύλλου στη θέση s &#40;μετά το s - 1&#41;
        Worksheets.Add After&#58;=Sheets&#40;s - 1&#41;
    
         ' Ονομασία Φύλλου s από το πρώτο κελί της στήλης j
        Worksheets&#40;s&#41;.Name = Worksheets&#40;1&#41;.Cells&#40;1, j&#41;
        
        ' Γραμμή 2 &#40;Φύλλο 1&#41;, Γραμμή 1 &#40;Φύλλο s&#41;
        ia = 2
        ib = 1
        
        ' Όσο δεν είναι κενό το κελί της γραμμής ia και της στήλης B του Φύλλου 1 επαναλαμβάνει
        While Worksheets&#40;1&#41;.Cells&#40;ia, 2&#41; <> ""
        
            ' Προσωρινή αποθήκευση του κελιού
            temp = Worksheets&#40;1&#41;.Cells&#40;ia, j&#41;.Value
            
            ' Αν δεν είναι 0...
            If temp <> 0 Then

                ' ...αντιγράφει στη γραμμή ib και τη στήλη C στο Φύλλο s τον τίτλο που βρίσκεται στη γραμμή ia και τη στήλη B του Φύλλου 1
                Worksheets&#40;s&#41;.Cells&#40;ib, 3&#41;.Value = Worksheets&#40;1&#41;.Cells&#40;ia, 2&#41;.Value

                ' και στη γραμμή ib και τη στήλη H το προσωρινά αποθηκευμένο κελί
                Worksheets&#40;s&#41;.Cells&#40;ib, 8&#41;.Value = temp
                
                ' Επόμενη γραμμή του Φύλλου s
                ib = ib + 1
            End If
            
            ' Επόμενη γραμμή του Φύλλου 1
            ia = ia + 1
        Wend
        
        ' Επόμενο φύλλο
        s = s + 1
        
        ' Επόμενη στήλη
        j = j + 1
    Wend
End Sub

NikosJC
Δημοσιεύσεις: 9
Εγγραφή: 27 Οκτ 2007 19:05

Macro Xls (VB)

Δημοσίευση από NikosJC » 12 Μαρ 2011 10:30

Φίλε μου σ'ευχαριστώ πάρα πολύ που κάθησες και ασχολήθηκες τόσο!!! Έκανες πραγματικά άψογη δουλειά, ακριβώς αυτό που ήθελα!!! Και απόλυτα κατανοητό!

Το είχα παλέψει και εγώ με while, αλλά επειδή δεν ξέρω πολύ καλά την γλώσσα, δεν ήξερα πως να δηλώνω τις τιμές γραμμής-στήλης ώστε να τις διαχειρίζομαι όπως θέλω, και όλο κάπου κόλλαγα! Στην ουσία δεν ήξερα πως να χρησιμοποιήσω το Worksheets(1).Cells(x, y) και 2-3 τεχνικές ακόμα που έχεις χρησιμοποιήσει και θα με βοηθήσουν πολύ!

Τώρα μπορώ να "παίξω" και με κάνα-δυο άλλα πραγματάκια που ήθελα να κάνω!

Και πάλι σ'ευχαριστώ πολύ! :respect:

NikosJC
Δημοσιεύσεις: 9
Εγγραφή: 27 Οκτ 2007 19:05

Macro Xls (VB)

Δημοσίευση από NikosJC » 10 Μάιος 2011 12:07

Καλησπέρα,

Μέσα στον παραπάνω κώδικα, μαζί με κάποιες άλλες προσθήκες, χρειάστηκε να περάσω και μια ρουτίνα για αυτόματο σώσιμο των φύλλων του excel σε csv αρχείο. Έτσι αφού σε μια μεταβλητή name περνάω το όνομα του κάθε φύλλου:

' Ονομασία Φύλλου s από το πρώτο κελί της στήλης j
name = Worksheets(1).Cells(1, j)
Worksheets(s).name = Worksheets(1).Cells(1, j)

...

Μετά, στο σημείο παρακάτω, κάνω το save σε τύπο .csv που το χρειάζομαι.
...

' Επόμενο φύλλο
s = s + 1

' Επόμενη στήλη
j = j + 1

' Αυτόματη αποθήκευση σε csv.
ActiveWorkbook.SaveAs Filename:="E:\Save" + name + ".csv", _
FileFormat:=xlCSV, CreateBackup:=False

Wend

Το πρόβλημα είναι το εξής. Ενώ αν δεν έχω το αυτόματο save, αλλά πηγαίνω σε κάθε φύλλο και το σώνω ένα-ένα όλα πηγαίνουν -σχεδόν- ρολόι και το csv σώνεται κανονικά (όταν το ανοίγω και πάλι με το excel είναι όλα στην σωστή θέση), όταν κάνω το αυτόματο save, ενώ τα σώνει όλα μαζί, δυστυχώς δεν τα σώνει σωστά. Δηλαδή μαζεύει όλες τις πληροφορίες κάθε γραμμής στην πρώτη στήλη (Α) σε αυτή τη μορφή:
Πχ. Ροδέλα Μ25x1,5 - PG11,,,,,1,0501-07-1125,,,,,1,,,,25/02/2011
πράγμα που στη συνέχεια μου προκαλεί προβλήματα.

Στο -σχεδόν- ρολόι πήγαινε στο άλλο προβληματάκι που αντιμετωπίσω. Σε κάποιες περιπτώσεις (δεν έχω καταλάβει πως και γιατί) ακόμα και στο σώσιμο κάθε φύλλου ξεχωριστά, μπορεί να μου κρατάει τις στήλες όπως θα έπρεπε να είναι, αλλά αντί να ξεκινάνε από την στήλη D ας πούμε που είναι η πρώτη με δεδομένα (γιατί θέλω τις προηγούμενες κενές), μετά το save τα δεδομένα ξεκινάνε από τη στήλη Α. Για αυτό έχω προσπαθήσει τουλάχιστον στην πρώτη γραμμή και στην πρώτη στήλη (Α1) να κάνω εισαγωγή απλά ενός κενού " ", και έτσι διορθώνεται το πρόβλημα.


Αν έχει κάποιος καμιά ιδέα για τα παραπάνω ας με βοηθήσει please...!

Ευχαριστώ.

Απάντηση

Επιστροφή στο “Office, Excel, Word VB Scripts και Tips”

Μέλη σε σύνδεση

Μέλη σε αυτήν τη Δ. Συζήτηση: Δεν υπάρχουν εγγεγραμμένα μέλη και 1 επισκέπτης