Η ιδέα για αυτή την εβδομάδα προήλθε από τη συνομιλία με τον Δρ M, συγγραφέα του μεγάλου εβδομαδιαίου ενημερωτικού δελτίου συμβουλών Quicken.
Λατρεύω τον Quicken, αλλά σίγουρα έχει τις ενοχλήσεις του. Έχω μια συγκεκριμένη απομνημόνευση αναφοράς στο Quicken με κατηγορίες στο πλάι και μήνες πέρα από την κορυφή. Το Quicken προσφέρει την ευκαιρία να εκτυπώσω αυτήν την αναφορά, αλλά φυσικά, χρησιμοποιώ πάντα την εντολή Αντιγραφή για να αντιγράψω την αναφορά στο πρόχειρο και στη συνέχεια να χρησιμοποιήσω την Επεξεργασία> Επικόλληση στο Excel για να αντιγράψω την αναφορά στο πρόχειρο. Αυτή η δυνατότητα είναι πολύ πιο γρήγορη από την παλαιότερη (και ακόμα διαθέσιμη) εκτύπωση σε μια επιλογή αρχείου .prn.
Εδώ εμφανίζονται οι ενοχλήσεις. Πρώτον, ο Quicken δεν ενοχλήθηκε να αντιγράψει τις επικεφαλίδες στηλών με την αναφορά. Επομένως, πρέπει να εισαγάγω με μη αυτόματο τρόπο τα ονόματα του μήνα στο Excel. Αρκετά απλό. Δεύτερον, οι κατηγορίες που αντιγράφονται στο πρόχειρο περιλαμβάνουν μια ενοχλητική μορφή διάρθρωσης για κατηγορίες και υποκατηγορίες.
Το Quicken σας επιτρέπει να χρησιμοποιήσετε κατηγορίες και υποκατηγορίες για να ταξινομήσετε τα έξοδά σας. Στην έκθεση στα αριστερά, τα έξοδα αυτοκινήτων κατανέμονται περαιτέρω ανά ασφάλιση, βενζίνη, επισκευές και πινακίδες. Ίσως έκανα μια κακή δουλειά για τη δημιουργία των κατηγοριών μου, αλλά διαπιστώνω ότι έχω κάποιες κατηγορίες όπου θέλω να δω τη λεπτομέρεια της υποκατηγορίας και άλλες κατηγορίες όπου θα προτιμούσα να δω απλώς το σύνολο της κατηγορίας.
Θα ήθελα επίσης να μπορώ να ταξινομήσω αυτήν την αναφορά στο Excel. Θα ήταν χρήσιμο να το ταξινομήσετε κατά συνολικό κόστος και μετά να το ταξινομήσετε ανά κατηγορία. Σίγουρα, θα μπορούσα να χρησιμοποιήσω την αναίρεση, αλλά θα ήθελα κατηγορίες αλφαβητικής φύσης. Εν ολίγοις, δεν με νοιάζει για τη μορφή διάρθρωσης που χρησιμοποιεί ο Quicken.
Οι αναγνώστες εδώ και πολύ καιρό θα θυμούνται την περιφρόνησή μου για τη μορφή διάρθρωσης που χρησιμοποιείται από τους συγκεντρωτικούς πίνακες στο Συμπλήρωμα κενών πινάκων κενών κελιών χρησιμοποιώντας τη συμβουλή Go to Special Έχουμε την ίδια κατάσταση εδώ. Εάν η αναφορά Quicken είναι απλώς ένα ενδιάμεσο βήμα και θέλετε να μπορείτε να ταξινομήσετε ανά κατηγορία, η μορφή διάρθρωσης είναι φρικτή. Μετά την ταξινόμηση κατά σύνολα και, στη συνέχεια, ανά κατηγορία, η κατηγορία Auto: Insurance θα ταξινομηθεί εσφαλμένα στην ενότητα "I" της αναφοράς. Για τις κατηγορίες όπου διατηρώ μόνο το σύνολο, θα ταξινομηθούν λανθασμένα στην ενότητα "Τ" της αναφοράς.
Υπήρχαν δύο βοηθητικά προγράμματα που νόμιζα ότι θα διευκόλυνε αυτήν την κατάσταση. Ένα βοηθητικό πρόγραμμα ονομάζεται κατάρρευση. Όταν γίνεται επίκληση, αυτή η μακροεντολή θα συμπτύξει μια υποκατηγορία σε μία γραμμή με το κατάλληλο όνομα κατηγορίας. Στο παραπάνω παράδειγμα, η εκτέλεση της μακροεντολής ενώ ο δείκτης κελιού βρίσκεται οπουδήποτε στις σειρές 34 έως 38 θα αντικαταστήσει την κατηγορία στο A38 με "Υπολογιστής" και θα διαγράψει τις σειρές 34 έως 37.
Το βοηθητικό πρόγραμμα δύο αφορά τις κατηγορίες στις οποίες θα ήθελα να δω τη λεπτομέρεια της υποκατηγορίας, αλλά δεν χρειάζομαι την επικεφαλίδα, τη διακεκομμένη υποσύνολο γραμμή, ούτε το σύνολο κατηγοριών. Αυτό το βοηθητικό πρόγραμμα ονομάζεται Fill. Θα βρει το κατάλληλο όνομα κατηγορίας και θα προθέσει κάθε υποκατηγορία με την κατατομή. Στο παραπάνω παράδειγμα, η εκτέλεση της μακροεντολής ενώ ο δείκτης κελιού βρίσκεται οπουδήποτε στις σειρές 24 έως 30 θα έχει ως αποτέλεσμα την αλλαγή των κελιών A25: A28 σε μορφή όπως "Auto: Insurance". Οι σειρές 24, 29 και 30 θα διαγραφούν.
Δεξιά, είναι η βελτιωμένη έκδοση της αναφοράς μου. Αναθέτοντας Σύμπτυξη και Συμπλήρωση σε πλήκτρα συντόμευσης, μπόρεσα να κάνω αυτές τις αλλαγές με λίγες πατήσεις πλήκτρων. Είναι πλέον εύκολο να ταξινομήσετε την αναφορά, γνωρίζοντας ότι η αναφορά μπορεί να επιστρέψει στην αρχική της ακολουθία ταξινομώντας την κατηγορία.
Εάν είστε νέοι στις μακροεντολές, ανατρέξτε στην ενότητα Εισαγωγή του Excel VBA Editor.
Μόλις αντιγράψετε τη μακροεντολή, μπορείτε να εκχωρήσετε ένα πλήκτρο πρόσβασης ακολουθώντας αυτά τα βήματα:
- Από το μενού Εργαλεία, επιλέξτε Μακροεντολές και, στη συνέχεια, Μακροεντολή
- Επισημάνετε τη μακροεντολή Συμπλήρωσης. Κάντε κλικ στο Επιλογές. Στο πεδίο Συντόμευση, εισαγάγετε οποιοδήποτε γράμμα. Χρησιμοποιώ f για Fill. Κάντε κλικ στο OK
- Επισημάνετε τη μακροεντολή σύμπτυξης. Κάντε κλικ στο Επιλογές. Επιλέξτε ένα γράμμα για μια συντόμευση, αλλά μείνετε μακριά από το c, καθώς το Ctrl + c είναι η κοινή συντόμευση
- για Επεξεργασία> Αντιγραφή. Κάντε κλικ στο OK
- Κλείσιμο του διαλόγου μακροεντολής με Άκυρο.
Στο πλαίσιο της προσπάθειάς του να σχεδιάσει ένα πρόσθετο σε μια μέρα, ο θερινός ασκούμενος, ο Anhtuan Do δημιούργησε τις ακόλουθες μακροεντολές.
Option Explicit Dim Flag, Flag2 As Boolean 'Flags to keep the Find Procedures running Dim HeaderRow, TotalRow As Integer 'Number of the Header and Total Rows Dim Counter As Integer 'Counter to ensure searches are relative to activecell Dim TempString, TempTest As String 'Strings that are used as temporary holders to compare Dim CategoryName As String 'Name of the category currently in Sub Collapse() 'To collapse the rows, run this macro Flag = False Flag2 = False Counter = -1 'Continue looping until HeaderRow is found Do Until Flag = True Counter = Counter + 1 Call FindHeader Loop 'Create CategoryName CategoryName = Left(CategoryName, Len(CategoryName) - 1) CategoryName = Trim(CategoryName) 'Assign HeaderRow HeaderRow = ActiveCell.Row - Counter Counter = 0 'Continue looping until TotalRow is found Do Until Flag2 = True Counter = Counter + 1 Call FindTotal Loop 'Assign TotalRow TotalRow = ActiveCell.Row + Counter 'Replace "TOTAL Category" with "Category" Cells(TotalRow, 1).Value = " " & CategoryName 'Deleting sub-category rows Rows(HeaderRow & ":" & TotalRow - 1).Delete Shift:=xlUp End Sub Sub Fill() 'To add the CategoryName to each of the types, run this macro Dim i As Integer Flag = False Flag2 = False Counter = -1 'Continue looping until HeaderRow is found Do Until Flag = True Counter = Counter + 1 Call FindHeader Loop 'Create CategoryName CategoryName = Left(CategoryName, Len(CategoryName) - 1) CategoryName = Trim(CategoryName) 'Assign HeaderRow HeaderRow = ActiveCell.Row - Counter Counter = 0 'Continue looping until TotalRow is found Do Until Flag2 = True Counter = Counter + 1 Call FindTotal Loop 'Assign TotalRow TotalRow = ActiveCell.Row + Counter 'Adding CategoryName and colon to the start of each sub category For i = HeaderRow + 1 To TotalRow - 2 TempString = Trim(Cells(i, 1).Value) Cells(i, 1).Value = " " & CategoryName & ": " & TempString Next i 'Deleting Header and Total Row Rows(TotalRow & ":" & TotalRow - 1).Delete Shift:=xlUp Rows(HeaderRow).Delete Shift:=xlUp End Sub Sub FindHeader() Dim i As Integer TempString = Cells(ActiveCell.Row - Counter, 1).Value 'Checking to see if in first row If (ActiveCell.Row - Counter) = 1 Then MsgBox "You are not in a collapsable row" End If 'Checking to see if in a valid row 'If it reaches a TOTAL before reaching a colon, then error If Left(Trim(TempString), 5) = "TOTAL" Then MsgBox "You are not in a collapsable row" End If 'Checking the String for a colon For i = 1 To Len(TempString) TempTest = Mid(TempString, i, 1) If TempTest = ":" Then CategoryName = TempString Flag = True Exit For End If Next i End Sub Sub FindTotal() Dim i As Integer 'Finding the TOTAL Row TempString = Cells(ActiveCell.Row + Counter, 1).Value TempString = Trim(TempString) If TempString = "TOTAL " & CategoryName Then Flag2 = True End If End Sub
