Excel - Μια μακροεντολή για να βρείτε έναν συγκεκριμένο αριθμό σε μια λίστα

Θέμα

Προσπαθώ να γράψω μια μακροεντολή στο Excel που πρέπει να εκτελέσει τις παρακάτω λειτουργίες:

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

Το πρότυπο είναι όπως παρακάτω:

Όταν κάνω κλικ στο κουμπί εντολής και εισάγετε τον αριθμό 307304 στο πλαίσιο εισαγωγής. θα πρέπει να με πάει στο συγκεκριμένο κελί και όπου πρέπει να συλλαμβάνεται ο χρόνος έναρξης. Εάν κάνω κλικ ξανά, θα πρέπει να καταγραφεί η ώρα λήξης. (αυτές οι ώρες θα πρέπει να είναι η τρέχουσα ώρα).

 # Χρόνος λήξης Ώρα έναρξης εργασίας
307301
307302
307303
307304
307305
307306
307307
307308
307309
307310 

Λύση

Πιέστε αυτό. Η ρουτίνα που πρέπει να χρησιμοποιήσετε είναι doTimeStamp

Η ιδέα είναι να επισυνάψετε αυτή τη ρουτίνα στο κουμπί εντολής. Όταν κάνετε κλικ σε αυτό, θα ζητηθεί η ιδιότητα emp και θα συμπληρωθεί η ημερομηνία έναρξης (αν είναι κενή) ή η ημερομηνία λήξης (αν είναι κενή) και στη συνέχεια θα σας ζητηθεί ξανά για το επόμενο id. Θα συνεχίσει να σας ζητάει id έως ότου εισάγετε ένα κενό και εκείνο το σημείο θα σταματήσει.

Προαιρετική επιλογή
Δημόσια Sub doTimeStamp ()
Dim lRow As Long
Dim sSearchText ως συμβολοσειρά
ΜΗΝ ΕΙΝΑΙ ΕΛΑΤΤΩΜΕΝΗ
Dim sTgtSheet ως συμβολοσειρά
'το όνομα του φύλλου όπου είναι τα IDs
sTgtSheet = "Φύλλο1"
Κάνω
sSearchText = InputBox ("Παρακαλώ εισάγετε το αναγνωριστικό υπαλλήλου", "Καταγραφή χρόνου")
sSearchText = Περικοπή (sSearchText)
Αν (sSearchText = vbNullString) _
Επειτα
'δεν καταχωρήθηκαν δεδομένα. τότε κλείστε
GoTo Loop_Bottom
Τέλος εαν
Αν δεν είναι (IsNumeric (sSearchText)) _
Επειτα
'Το κείμενο που εισήχθη δεν ήταν αριθμητικό.
MsgBox "Μη έγκυρο αναγνωριστικό υπάλληλο. Το αναγνωριστικό υπάλληλου μπορεί να είναι μόνο ψηφία. Δοκιμάστε πάλι", vbExclamation + vbOKOnly
GoTo Loop_Bottom
Τέλος εαν
Αν (InStr (1, sSearchText, ".")> 0) _
Επειτα
'το κείμενο που εισήχθη είχε ένα δεκαδικό.
MsgBox "Μη έγκυρο αναγνωριστικό υπάλληλο. Το αναγνωριστικό υπάλληλου μπορεί να είναι μόνο ψηφία. Δοκιμάστε πάλι", vbExclamation + vbOKOnly
GoTo Loop_Bottom
Τέλος εαν
'εντοπίστε τη σειρά στη στήλη 1
lRow = getItemLocation (sSearchText, Φύλλα (sTgtSheet) .Κολάμες (1))
Αν (lRow = 0) _
Επειτα
'η αναζήτηση δεν επέστρεψε κανένα χτύπημα
MsgBox "Δεν βρέθηκε αναγνωριστικό προσωπικού, προσπαθήστε ξανά", vbInformation + vbOKOnly
GoTo Loop_Bottom
Τέλος εαν
Εάν (φύλλα (sTgtSheet) .Cells (lRow, "B") = vbNullString) _
Επειτα
'του κελιού της ευρεθείσας σειράς έχει κενή στήλη Β
Φύλλα (sTgtSheet) .Cells (lRow, "B") = Τώρα
ElseIf (φύλλα (sTgtSheet) .Cells (lRow, "C") = vbNullString) _
Επειτα
'του κυττάρου της γραμμής που βρέθηκε έχει κενή στήλη C
Φύλλα (sTgtSheet) .Cells (lRow, "C") = Τώρα
Αλλού
'το κελί της ευρισκόμενης σειράς έχει στήλη B και C συμπληρωμένη
MsgBox "Η ώρα έναρξης και λήξης έχει ήδη εγγραφεί για τους υπαλλήλους" & sSearchText, vbInformation + vbOKOnly
Τέλος εαν
Loop_Bottom:
'loop μέχρι το sSearchText είναι κενό
Βρόχος ενώ (sSearchText vbNullString)
End Sub
Δημόσια Λειτουργία getItemLocation (sLookFor As String, _
rngSearch As Range, _
Προαιρετική τιμή bFullString ως Boolean = True, _
Προαιρετικά bLastOccurance Ως Boolean = True, _
Προαιρετικό bFindRow ως Boolean = True) όσο καιρό
'βρείτε την πρώτη / τελευταία σειρά / στήλη εντός εύρους για μια συγκεκριμένη συμβολοσειρά
Dim Cell As Range
Διασκεδάστε ως ακέραιο
Dim iSearchDir ως ακέραιο
Dim iSearchOdr ως ακέραιο
Αν (bFullString) _
Επειτα
iLookAt = xlWhole
Αλλού
iLookAt = xlPart
Τέλος εαν
Αν (bLastOccurance) _
Επειτα
iSearchDir = xLPrevious
Αλλού
iSearchDir = xlNext
Τέλος εαν
Αν δεν είναι (bFindRow) _
Επειτα
iSearchOdr = xlByColumns
Αλλού
iSearchOdr = xlByRows
Τέλος εαν
Με rngSearch
Αν (bLastOccurance) _
Επειτα
Ορίστε το στοιχείο Cell = .Find (sLookFor, .Cells (1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
Αλλού
Ορίστε το στοιχείο Cell = .Find (sLookFor, .Cells (.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
Τέλος εαν
Τέλος με
Αν το Cell δεν είναι τίποτα τότε
getItemLocation = 0
Αλλιώς δεν είναι (bFindRow) _
Επειτα
getItemLocation = Cell.Column
Αλλού
getItemLocation = Cell.Row
Τέλος εαν
Ορισμός κελιού = Τίποτα
Λειτουργία τερματισμού 

Σημειώστε ότι

Χάρη στην rizvisa1 για αυτή την συμβουλή.