Προς το περιεχόμενο

Βοήθεια Excel για αντιγραφή κελιών με προυποθέσεις


Jason13

Προτεινόμενες αναρτήσεις

45 λεπτά πριν, rafinos είπε

Ακόμα και αυτό με το filter πιο χρονοβόρο είναι από τη λύση με την If. 

Συνεχίζεις να θεωρείς πως η λύση που πρότεινες είναι σούπερ ουάου. Αλλά όχι, αυτό δεν είναι καθόλου μα καθόλου αλαζονικό. 

Ό,τι πεις! 

Μα εγω ημουν ο πρωτος που ειπα οτι αφου γινετε πιο ευκολα με μια συναρτηση +1 σε σενα.
Αλλα εδω τωρα κανουμε Debug εχει διαφορα με το να λεμε πια η λυση η σωστη και τι και πως.Εδω μενουμε στο θεμα οτι επιμενεις να λες οτι το Excel μου ειναι λαθος ΕΝΩ απλα δεν ΕΙΝΑΙ!  τελεια και παυλα οτι αλλο θες να πεις να το δεχτω αυτο ομως οχι.

 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

  • Απαντ. 33
  • Δημ.
  • Τελ. απάντηση

Συχνή συμμετοχή στο θέμα

17 λεπτά πριν, papmel είπε

Μα εγω ημουν ο πρωτος που ειπα οτι αφου γινετε πιο ευκολα με μια συναρτηση +1 σε σενα.
Αλλα εδω τωρα κανουμε Debug εχει διαφορα με το να λεμε πια η λυση η σωστη και τι και πως.Εδω μενουμε στο θεμα οτι επιμενεις να λες οτι το Excel μου ειναι λαθος ΕΝΩ απλα δεν ΕΙΝΑΙ!  τελεια και παυλα οτι αλλο θες να πεις να το δεχτω αυτο ομως οχι.

 

Δοκίμασα ό,τι είπες και δεν λειτουργεί. Δηλαδή με το ζόρι να πω ότι λειτουργεί! Θα μας τρελάνεις μου φαίνεται! 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

15 λεπτά πριν, rafinos είπε

Δοκίμασα ό,τι είπες και δεν λειτουργεί. Δηλαδή με το ζόρι να πω ότι λειτουργεί! Θα μας τρελάνεις μου φαίνεται! 

Κοιτα εγω θα χασω 100 ευρω αν εχεις δικιο και εσυ θα πεις απλα μια Συγνώμη. Αν δεν στα δώσω ΚΡΑΞΕΜΕ παει?
αρκει να δουμε τι λες εσυ και τι λεω εγω. θες? αν ναι παμε να κανουμε μαζι τα βηματα.

1) βαζεις 2 στηλες οσα records Θες

Α1              B1
2 ψωμι   | ιανουαριος
3 νερο   | φεβρουάριος
4 γαλα   | Μαρτιος
5 γαλα  | Απρίλιος
6 ψωμι  | ΜΑιος
7 νερο  |  ιανουαριος
8 Αλάτι  | αυγουστος.


το Excel θα κανει τα εχεις

Θα φτιάξει πρωτα απο την Θεση 4 στην πρωτη εγγραφης τους μηνες με την σειρα που θα τους βρει.
αρα θα εχουμε Ιανουαριος Φεβρουαριος Μαρτιος Απριλιος ΜΑιος Αυγουστος.
και μετα σε καθε μηνα θα βαλει το αντιστοιχο πεδιο απο την πρωτη στηλη.

Εσυ απλα γραψε 2 στηλες στην μια τα προιοντα ας πουμε και στην αλλη τους μηνες με οπια σειρα θες
Σωσε το Excel και ξανα ανοιξε το  και θα στα εχει βγαλει ολα οπως πρεπει.
Αφου κανεις αυτο Πες μου τι DATA Εδωσες και τι "ΛΑΘΟΣ" κανει και τοτε θα σου βγαλω το καπελο και υα πω ειχες δικιο κακως επεμενα.
Αν δεν τα κανεις αυτα ομως τι συζηταμε τσαμπα.Και δεν εχω ανεβασει αλλο Excel αυτο που ηταν παντα ειναι στον Server μου μπορεις να συγκρινεις τα Bytes.








 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

3 λεπτά πριν, papmel είπε

Κοιτα εγω θα χασω 100 ευρω αν εχεις δικιο και εσυ θα πεις απλα μια Συγνώμη. Αν δεν στα δώσω ΚΡΑΞΕΜΕ παει?
αρκει να δουμε τι λες εσυ και τι λεω εγω. θες? αν ναι παμε να κανουμε μαζι τα βηματα.

1) βαζεις 2 στηλες οσα records Θες

Α1              B1
2 ψωμι   | ιανουαριος
3 νερο   | φεβρουάριος
4 γαλα   | Μαρτιος
5 γαλα  | Απρίλιος
6 ψωμι  | ΜΑιος
7 νερο  |  ιανουαριος
8 Αλάτι  | αυγουστος.


το Excel θα κανει τα εχεις

Θα φτιάξει πρωτα απο την Θεση 4 στην πρωτη εγγραφης τους μηνες με την σειρα που θα τους βρει.
αρα θα εχουμε Ιανουαριος Φεβρουαριος Μαρτιος Απριλιος ΜΑιος Αυγουστος.
και μετα σε καθε μηνα θα βαλει το αντιστοιχο πεδιο απο την πρωτη στηλη.

Εσυ απλα γραψε 2 στηλες στην μια τα προιοντα ας πουμε και στην αλλη τους μηνες με οπια σειρα θες
Σωσε το Excel και ξανα ανοιξε το  και θα στα εχει βγαλει ολα οπως πρεπει.
Αφου κανεις αυτο Πες μου τι DATA Εδωσες και τι "ΛΑΘΟΣ" κανει και τοτε θα σου βγαλω το καπελο και υα πω ειχες δικιο κακως επεμενα.
Αν δεν τα κανεις αυτα ομως τι συζηταμε τσαμπα.Και δεν εχω ανεβασει αλλο Excel αυτο που ηταν παντα ειναι στον Server μου μπορεις να συγκρινεις τα Bytes.








 

Ρε συ, το θέμα δεν είναι ούτε να βάλουμε στοίχημα ούτε κάτι. Το δοκίμασα δύο φορές και δεν λειτούργησε και έκανα ακριβώς αυτό που είπες (για αυτό και το δοκίμασα δύο φορές), τώρα μπορεί να έχει θέμα το excel μου τι να σου πω. Δηλαδή το πρόβλημά σου θα λυθεί αν σου ζητήσω συγγνώμη. Στο ζητάω και έτσι. Συγγνώμη! Ας το λήξουμε εδώ. 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Cool down guys!

Δεν είναι λόγος τώρα αυτός για σφοδρή αντιπαράθεση, επιθέσεις και χαρακτηρισμούς. Ο καθένας μπορεί να επιτύχει το ζητούμενο με το δικό του τρόπο και από την οδό που βολεύεται. Ο papmel –ο οποίος επικρότησε αμέσως τον τρόπο με την IF()– είπε πως χρησιμοποίησε κώδικα διότι του διαφεύγουν οι συναρτήσεις του Excel, η οποία εξήγηση, για μένα, είναι πλήρως αποδεκτή. Προσωπικά, είμαι σύμφωνος με το επιχείρημα των χιλίων Excel με τις 50Κ rows, το οποίο όμως εμπίπτει στην περίπτωση "αυτοματοποίηση της εφαρμογής" και είναι άσχετο με το παρόν θέμα. Ίσως ο κώδικας να χρειάζεται βελτίωση για να γίνει "γενικής χρήσης" μιας και, όπως φαίνεται, ο TS έχει καλυφθεί, αλλά, η γόνιμη συζήτηση θα ήταν "Περί της [βέλτιστης] Μεθόδου" και στο πλαίσιο αυτής ήταν και τα σχόλιά μου και μάλιστα καλοπροαίρετα. Η λύση με τα φίλτρα θα μπορούσε να αυτοματοποιηθεί (ή να γίνει και πάλι με τύπο) αλλά, όπως φαίνεται, ο TS ήθελε οι τιμές στον πίνακα να εμφανίζονται στην ίδια σειρά με αυτή της λίστας.

Καλή συνέχεια!

Υ.Γ. papmel, με μπέρδεψες με τον rafinos. :)

  • Thanks 1
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Δημοσ. (επεξεργασμένο)
17 λεπτά πριν, MastroGiannis είπε

Cool down guys!

Δεν είναι λόγος τώρα αυτός για σφοδρή αντιπαράθεση, επιθέσεις και χαρακτηρισμούς. Ο καθένας μπορεί να επιτύχει το ζητούμενο με το δικό του τρόπο και από την οδό που βολεύεται. Ο papmel –ο οποίος επικρότησε αμέσως τον τρόπο με την IF()– είπε πως χρησιμοποίησε κώδικα διότι του διαφεύγουν οι συναρτήσεις του Excel, η οποία εξήγηση, για μένα, είναι πλήρως αποδεκτή. Προσωπικά, είμαι σύμφωνος με το επιχείρημα των χιλίων Excel με τις 50Κ rows, το οποίο όμως εμπίπτει στην περίπτωση "αυτοματοποίηση της εφαρμογής" και είναι άσχετο με το παρόν θέμα. Ίσως ο κώδικας να χρειάζεται βελτίωση για να γίνει "γενικής χρήσης" μιας και, όπως φαίνεται, ο TS έχει καλυφθεί, αλλά, η γόνιμη συζήτηση θα ήταν "Περί της [βέλτιστης] Μεθόδου" και στο πλαίσιο αυτής ήταν και τα σχόλιά μου και μάλιστα καλοπροαίρετα. Η λύση με τα φίλτρα θα μπορούσε να αυτοματοποιηθεί (ή να γίνει και πάλι με τύπο) αλλά, όπως φαίνεται, ο TS ήθελε οι τιμές στον πίνακα να εμφανίζονται στην ίδια σειρά με αυτή της λίστας.

Καλή συνέχεια!

Υ.Γ. papmel, με μπέρδεψες με τον rafinos. :)

Ναι Sorry :)))))))))))))))))
 

21 λεπτά πριν, rafinos είπε

Ρε συ, το θέμα δεν είναι ούτε να βάλουμε στοίχημα ούτε κάτι. Το δοκίμασα δύο φορές και δεν λειτούργησε και έκανα ακριβώς αυτό που είπες (για αυτό και το δοκίμασα δύο φορές), τώρα μπορεί να έχει θέμα το excel μου τι να σου πω. Δηλαδή το πρόβλημά σου θα λυθεί αν σου ζητήσω συγγνώμη. Στο ζητάω και έτσι. Συγγνώμη! Ας το λήξουμε εδώ. 

μα δεν εχω κατι μαζι σου ουτε εχω τσαντιστει απλα επειδη το εχω κανει 20 φορες απο την ωρα που μου το ειπες δεν μπορω να καταλαβω τι λες οτι κανει λαθος.
το excel Μου ειναι 2013 αλλα εχω ενεργοποιησει το Microsoft Scripting στο Tools Reference
Βάζω ενα κουμπι και ανεβαζω και δευτερο Excel με τον ιδιο κωδικα να μου πεις αν στο τρεχει.
ισως απο excel σε excel αλλαζει κατι .Εγω ουτε καν βαζω το excel στο pc μου ο λογος που το εχω ειναι γιατι στελνουν καποιοι excel και πρεπει να το ανοιγω.
οι Εντολες ειναι Classic ASP ( δεν ξερω γιατι τις λεει VBA ) και ειναι οι ακολουθες για να το παρεις να το βαλεις στο δικο σου και αν δεις οτι κανει οτι λεω.


screenshot1.png.07d12d1e823e77f131f1154bf5d922d9.png

|
Ανοιξε ενα Excel και κανε παστε αυτες τις δυο στηλες στα κελια A και Β 

   
  Ιανουάριος
  φεβρουάριος
  Μαρτιος
  Απρίλιος
  Μαιος
  Ιούνιος
  Ιούλιος
  Αυγουστος
  Σεπτέμβριος
  Οκτώμβριος
  Νοέμβριος
  Δεκέμβριος
νερο Μαιος
γαλα Μαιος
νερο Ιούλιος
νερο Ιανουάριος
γαλα Σεπτέμβριος
τυρι Ιανουάριος
ψωμι Μαιος



ανοιχε με ALT+F11 και στο thisWorkBook κανε paste αυττο>

Private Sub Workbook_Open()

Dim last_row As Integer

'βρισκο το last Record για να ξερω ποσα ειναι 
last_row = Cells(Rows.count, 1).End(xlUp).Row

Dim dict
Dim dictposition

Set dict = CreateObject("Scripting.Dictionary")
Set dictposition = CreateObject("Scripting.Dictionary")

Dim minas As String
Dim x As Integer
Dim minasposition()
Dim count: count = 0

'prota pernoyme toys mines apo to col=2 gia ola ta records kai ta bazoume se ena dictionary
For x = 2 To last_row
minas = Cells(x, 2)
If Not dict.Exists(minas) Then
ReDim Preserve minasposition(count + 1)
minasposition(count) = count
dict.Add minas, minas
dictposition.Add minas, minasposition(count)
count = count + 1
End If
Next


'edo grafopume toys mines sto record 1 apo to keli 5 kai meta
countpositionminas = 0
Dim fmonth
For Each fmonth In dict.Items
Cells(1, 4 + dictposition(fmonth)) = fmonth
Next


'kai tora psaxnoyme an kapio keli einai idio me toys mines kai grafoume to pedio
Dim myvalue As String
For x = 2 To last_row
myvalue = Cells(x, 1)
minas = Cells(x, 2)
Cells(x, 4 + dictposition(minas)) = myvalue
Next

Set dict = Nothing
Set dictposition = Nothing
Erase minasposition


End Sub


πατησε το RUN και θα δεις αυτο.....
 

screenshot2.png.881e151351a758a4a783b631f830f0d7.png


αν τωρα δεν ειναι αυτο που θελει ο φιλος τοτε εγω δεν καταλαβα κατι και γιαυτο η παρεξηγηση 
αλλα μην μου λες δεν δουλεβει γιατι αυτα τα 2 Screen shot τα πηρα μολις τώρα απο το Excel και φυσικα και εσυ θα παρεις τα ιδια αν κανεις οτι εγραψα.



 

Επεξ/σία από papmel
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Ορίστε και ένα screenshot για να πιστείς ότι δεν λειτουργεί όπως θέλεις να πιστεύεις. 

Το έκανα στο αρχικό αρχείο που έστειλες. Τώρα είδα ότι έστειλες και κώδικα, αλλά η αλήθεια είναι ότι δεν θέλω να ασχοληθώ άλλο. Και εσύ θεωρώ ότι πολύ χρόνο σπατάλησες για να βρεις αν φταίει ή όχι κάτι. 


image.png.59c4f0b78f668c681684c247945f07d0.png
 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

9 λεπτά πριν, rafinos είπε

Ορίστε και ένα screenshot για να πιστείς ότι δεν λειτουργεί όπως θέλεις να πιστεύεις. 

Το έκανα στο αρχικό αρχείο που έστειλες. Τώρα είδα ότι έστειλες και κώδικα, αλλά η αλήθεια είναι ότι δεν θέλω να ασχοληθώ άλλο. Και εσύ θεωρώ ότι πολύ χρόνο σπατάλησες για να βρεις αν φταίει ή όχι κάτι. 


image.png.59c4f0b78f668c681684c247945f07d0.png
 

δεν εχεις ενεργοποιημενες τις Mαcro εντολες  η κατι αλλο που δεν το γνωριζω αν σου βγαζει αυτο με το που το ανοιγεις
Δεν γινετε να βγαζει αυτο παει να πει οτι κατι φταει και δεν ξερω τι .

Αν βαλεις τον κωδικα πιστευω θα στα δειξει ισως απο excel 2013 σε excel 2017 λη οτι αλλο εχεις δεν υπαρχει συμβατοτητα οπως ειπα δεν ειμε ειδικος στο Excel αλλα ειμαι ειδικος στην ASP.


 

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Δημοσ. (επεξεργασμένο)
16 λεπτά πριν, Predatorkill είπε

Λεω να ριξω λαδι στη φωτια, ανεβαστε και οι δυο ενα βιντεο στη πραξη, με screenshots και χυμα vbscript δεν γινεται δουλεια.

@rafinos @papmel

Μονο ετσι γιατι αλλιως θα τρελαθουμε εδω περα το φτιαχνω λοιπον.
 

VIDEO EXCEL

αν και μετα απο αυτο πιστευεις οτι το εκανε με το χερι το Video τοτε θα επρεπε να δουλεβω στην Disney και οχι να μιλαμε τωρα στο insomnia :)

Εγω ειμαι καλυμενος αν ο φιλος πει οτι ενταξει παιζει το excel αλλα σε μενα δεν παιζει.
και τοτε να αρχισουμε νο Γυρο συνομιλιων να βρουμε γιατι στο διαολο δεν παιζει χαχαχαχαχα

26 λεπτά πριν, Predatorkill είπε

Λεω να ριξω λαδι στη φωτια, ανεβαστε και οι δυο ενα βιντεο στη πραξη, με screenshots και χυμα vbscript δεν γινεται δουλεια.

@rafinos @papmel

Μια παρατηρηση δεν ειναι χυμα η Vbscript την εχω μεσα σε ενα Procedure :))))))

Επεξ/σία από papmel
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

49 λεπτά πριν, papmel είπε

Μια παρατηρηση δεν ειναι χυμα η Vbscript την εχω μεσα σε ενα Procedure :))))))

Χυμα στο φορουμ εννοουσα, αλλα whatever suits you best

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Δημοσ. (επεξεργασμένο)
1 ώρα πριν, papmel είπε

Μονο ετσι γιατι αλλιως θα τρελαθουμε εδω περα το φτιαχνω λοιπον.
 

VIDEO EXCEL

αν και μετα απο αυτο πιστευεις οτι το εκανε με το χερι το Video τοτε θα επρεπε να δουλεβω στην Disney και οχι να μιλαμε τωρα στο insomnia :)

Εγω ειμαι καλυμενος αν ο φιλος πει οτι ενταξει παιζει το excel αλλα σε μενα δεν παιζει.
και τοτε να αρχισουμε νο Γυρο συνομιλιων να βρουμε γιατι στο διαολο δεν παιζει χαχαχαχαχα

Μια παρατηρηση δεν ειναι χυμα η Vbscript την εχω μεσα σε ενα Procedure :))))))

Βασικά κάτι φταίει με το αρχείο που στέλνεις. Γιατί δεν μπορεί να γίνει επεξεργασία του vbscript ζητάει κωδικό. Σε νέο αρχείο λειτουργεί κανονικά ο κώδικάς σου. Ησύχασες τώρα που δεν έκανες λάθος στον κώδικά; :P

Τι κλειδώνει τώρα τον κώδικα δεν ξέρω. Μάλλον κάποια δικαιώματα του office είτε από τη δική σου μεριά είτε από την δική μου. Δε νομίζω να μάθουμε και ποτέ με τις μακακίες της MS. 

Επεξ/σία από rafinos
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

45 λεπτά πριν, rafinos είπε

Βασικά κάτι φταίει με το αρχείο που στέλνεις. Γιατί δεν μπορεί να γίνει επεξεργασία του vbscript ζητάει κωδικό. Σε νέο αρχείο λειτουργεί κανονικά ο κώδικάς σου. Ησύχασες τώρα που δεν έκανες λάθος στον κώδικά; :P

Τι κλειδώνει τώρα τον κώδικα δεν ξέρω. Μάλλον κάποια δικαιώματα του office είτε από τη δική σου μεριά είτε από την δική μου. Δε νομίζω να μάθουμε και ποτέ με τις μακακίες της MS. 

Perfect τωρα μπορω να παω για Υπνο.Λυθηκε το Μυστηριο!!!!!!!!!!

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Αφού λοιπόν αποκαταστάθηκε η αλήθεια, η ειρήνη και ο ύπνος του papmel, και, μιας και βρισκόμαστε στην ενότητα του προγραμματισμού και μέσα στο καταχείμωνο, αλλά και για αντιμετώπιση της ανίας, λέω να διατηρήσω λίγο την φωτιά που υποδαύλισε ο Predatorkill, παραθέτοντας με τη σειρά μου μια συντομότερη οδό προς την προσέγγιση του ζητούμενου μέσω κώδικα.  Αντί για Dictionary και Array, χρησιμοποιεί προσωρινά ένα αντικείμενο Collection μόνο και μόνο για την απόρριψη των διπλότυπων.

Private Sub MakeTable()
    Dim i As Long
    Dim r As Long
    Dim c As Integer
    Dim strKey As String
    Dim col As Collection

    'Ανάθεση τιμών στις μεταβλητές...
    Set col = New Collection                            'Δημιουργία βοηθητικής συλλογής.
    r = Range("b" & Rows.Count).End(xlUp).Row           'Εύρεση τελευταίας σειράς σε χρήση στη στήλη B.
    c = 4                                               'Αρχή πίνακα στη στήλη D.
    'Δημιουργία κεφαλίδας πίνακα...
    For i = 2 To r
        On Error Resume Next
        strKey = Range("b" & i).Text                    'Τρέχον όνομα μηνός.
        col.Add c, strKey                               'Προσπάθεια προσθήκης στη συλλογή.
        If Err = 0 Then                                 'Προστέθηκε με επιτυχία.
            Cells(1, c) = strKey                        'Προσθήκη νέας στήλης πίνακα.
            c = c + 1                                   'Αύξηση δείκτη θέσης
        End If
    Next i
    'Προσθήκη τιμών στον πίνακα...
    For i = 2 To r
        Cells(i, 4).Resize(, col.Count).ClearContents   'Διαγραφή περιεχομένων γραμμής πίνακα.
        Cells(i, col(Cells(i, 2))) = Cells(i, 1)        'Προσθήκη τιμής στο αντίστοιχο κελί πίνακα.
    Next i
    Set col = Nothing                                   'Καταστροφή στιγμιότυπου Collection.
End Sub

Για την ώρα, ο πίνακας ξεκινάει στο D1 του ίδιου φύλλου με τη λίστα.

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

Private Sub Worksheet_Change(ByVal Target As Range)
    'Επαναδημιουργία πίνακα μετά από κάθε αλλαγή στις στήλες "Α" και "Β".
    If Target.Column < 3 Then
        MakeTable
    End If
End Sub

 

  • Like 1
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Δημοσ. (επεξεργασμένο)
14 ώρες πριν, MastroGiannis είπε

Αφού λοιπόν αποκαταστάθηκε η αλήθεια, η ειρήνη και ο ύπνος του papmel, και, μιας και βρισκόμαστε στην ενότητα του προγραμματισμού και μέσα στο καταχείμωνο, αλλά και για αντιμετώπιση της ανίας, λέω να διατηρήσω λίγο την φωτιά που υποδαύλισε ο Predatorkill, παραθέτοντας με τη σειρά μου μια συντομότερη οδό προς την προσέγγιση του ζητούμενου μέσω κώδικα.  Αντί για Dictionary και Array, χρησιμοποιεί προσωρινά ένα αντικείμενο Collection μόνο και μόνο για την απόρριψη των διπλότυπων.



Private Sub MakeTable()
    Dim i As Long
    Dim r As Long
    Dim c As Integer
    Dim strKey As String
    Dim col As Collection

    'Ανάθεση τιμών στις μεταβλητές...
    Set col = New Collection                            'Δημιουργία βοηθητικής συλλογής.
    r = Range("b" & Rows.Count).End(xlUp).Row           'Εύρεση τελευταίας σειράς σε χρήση στη στήλη B.
    c = 4                                               'Αρχή πίνακα στη στήλη D.
    'Δημιουργία κεφαλίδας πίνακα...
    For i = 2 To r
        On Error Resume Next
        strKey = Range("b" & i).Text                    'Τρέχον όνομα μηνός.
        col.Add c, strKey                               'Προσπάθεια προσθήκης στη συλλογή.
        If Err = 0 Then                                 'Προστέθηκε με επιτυχία.
            Cells(1, c) = strKey                        'Προσθήκη νέας στήλης πίνακα.
            c = c + 1                                   'Αύξηση δείκτη θέσης
        End If
    Next i
    'Προσθήκη τιμών στον πίνακα...
    For i = 2 To r
        Cells(i, 4).Resize(, col.Count).ClearContents   'Διαγραφή περιεχομένων γραμμής πίνακα.
        Cells(i, col(Cells(i, 2))) = Cells(i, 1)        'Προσθήκη τιμής στο αντίστοιχο κελί πίνακα.
    Next i
    Set col = Nothing                                   'Καταστροφή στιγμιότυπου Collection.
End Sub

Για την ώρα, ο πίνακας ξεκινάει στο D1 του ίδιου φύλλου με τη λίστα.

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



Private Sub Worksheet_Change(ByVal Target As Range)
    'Επαναδημιουργία πίνακα μετά από κάθε αλλαγή στις στήλες "Α" και "Β".
    If Target.Column < 3 Then
        MakeTable
    End If
End Sub

 

Perfect 

Εγω λεω λοιπον τωρα μιας και παιζουμε μπαλιτσα με το Excel να κανουμε κατι πιο πρωτοτυπο.

Ζητειτε excel λοιπον που να κανει τα εξης.

Να γραφεις ενα τιτλο ταινιας
και με ενα Click να σου πεταει τα αποτελέσματα και τα MP4 λινκ για να τα δεις Direct στο VLC.

Μου ηρθε εχθες η ιδεα :)

και πιο αργα θα το φτιάξω οποτε ας δουμε και εδω ιδεες πανω σε αυτο οποιος εχει χρονο και διαθεση.











 

Επεξ/σία από papmel
Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Δημιουργήστε ένα λογαριασμό ή συνδεθείτε για να σχολιάσετε

Πρέπει να είστε μέλος για να αφήσετε σχόλιο

Δημιουργία λογαριασμού

Εγγραφείτε με νέο λογαριασμό στην κοινότητα μας. Είναι πανεύκολο!

Δημιουργία νέου λογαριασμού

Σύνδεση

Έχετε ήδη λογαριασμό; Συνδεθείτε εδώ.

Συνδεθείτε τώρα

  • Δημιουργία νέου...