[VBA] Μεταφορά δεδομένων σε ιστορικό

[gfevran]

Καλησπέρα,
Με βάση ενός έργου που βρήκα στο Forum «Χρήσιμα αρχεία & παραδείγματα».
Στην προσπάθεια μου να κατανοήσω και να μεταφέρω και άλλα στοιχεία στο ιστορικό,
π.χ. (Αρ. Κυκλ, ημερομηνία, Συνεργάτης, παρατηρήσεις)
προκειμένου να φτιάξω μια δική μου εφαρμογή δεν τα κατάφερα,
σε αυτό το σημείο χρειάζομαι βοήθεια.

Ευχαριστώ για όποια βοήθεια.

[Spirosgr]

Αν υποτεθεί, ότι θέλεις να μεταφέρεις, με βάση το ονοματεπώνυμο (2η στήλη στον πίνακα)
θα ονομάσεις την στήλη, πχ FullName και
στον υπάρχοντα κώδικα, του διπλού κλικ θα κάνεις:
1
Αλλαγή της περιοχής
If Intersect(Target, Sheet1.Range("c4:c11")) Is Nothing Then
σε
If Intersect(Target, Sheet1.Range("FullName ")) Is Nothing Then
2
Στο χώρο του Else
Οι μεταφορές (όποιων τιμών σου χρειάζονται) θα γίνουν με offset του κελιού
από target δεξιά+ ή αριστερά-
3
Στο τέλος πριν την έξοδο
Cancel = True
End Sub

Σημείωση:
Βέβαια, το συγκεκριμένο αρχείο, το έχεις κάνει άνω-κάτω, γιατί δεν ξέρω τώρα αν τελικά χρησιμοποίησες
τον κώδικα ή τους τύπους για τις προηγούμενες εργασίες...

[gfevran]

Γεια σου Σπύρο,
1. Αν κατάλαβα καλά το Ονοματεπώνυμο που είναι,
με Ελληνικούς χαρακτήρες στη δεύτερη στήλη του πίνακα,
θα το μετονομάσω σε FullName.

2. δεν κατάφερα να αλλάξω το συντακτικό με Offset.
και τα έχω κάνη σαλάτα.
Δεν έχω ξεκινήσω κάτι δικό μου προς το παρών, προσπαθώ,
να κατανοήσω τις αλλαγές που θέλω να κάνω του πιο πάνω έργου,
για να σχεδιάσω αυτό που έχω στο μυαλό μου.
Δεν έχω γνώση από κώδικα, ότι ξέρω τα έχω μάθει από το Forum,
Τα περισσότερα δε εξ αυτών από σένα.

Με εκτίμηση,
Γιώργος

[Spirosgr]

Γιώργο
Δεν θα αλλάξεις τα Ελληνικά, απλά σε Αγγλικά...
Θα ονομάσεις, την στήλη με ένα όνομα στον Namemanager.

[gfevran]

Σπύρο
Για να καταλάβεις πόσο προχωρημένος είμαι,
δεν ξέρω ούτε ο NameManager ποιος είναι.

[kapetang]

Καλησπέρα

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

Αντιγραφή γίνεται κάνοντας διπλό κλικ.

Νομίζω είναι κοντά σ’ αυτό που ζητάς, οπότε θα μπορούσες να το προσαρμόσεις στην εφαρμογή σου.

Φιλικά/Γιώργος

[kapetang]

Στο συνημμένο αρχείο έκανα κάποιες αλλαγές στον κώδικα, ώστε να γίνει συντομότερος.

Δε χρησιμοποιείται το βοηθητικό array για τον προσδιορισμό της κατηγορίας.

[Spirosgr]

Καλημέρα
Γιώργο (gfevran)...θα στα πω για μια φορά, όσο πιο απλά μπορώ...
εφ' όσον με τα θέματα, αναζήτησης και μεταφοράς, έχουμε ασχοληθεί πάρα πολλές φορές...

Ξέχνα το επάνω μέρος, του φύλλου και δες μόνο τον πίνακα...
Έχει μια στήλη, «Ονοματεπώνυμο», ok?
Την επιλέγεις και την ονομάζεις, FullName.
Η ονομασία γίνεται, όπως θα ονόμαζες, ένα κελί, μια περιοχή κλπ
στην διαχείριση ονομάτων (Namemanager),
ή στο «κουτάκι» αριστερά από την μπάρα των τύπων...στην κορδέλα.

Στο φύλλο, βάλε τον κώδικα (συμβάν διπλό κλικ)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim NRow As Integer
    Application.ScreenUpdating = False
    NRow = Sheet3.Cells(Rows.Count, 3).End(xlUp).Row + 1
    If Intersect(Target, Sheet1.Range("FullName")) Is Nothing Then
        Exit Sub
    Else
        If Target.Value <> vbNullString Then
            Sheet3.Cells(NRow, 3).Value = Sheet1.Cells(Target.Row, Target.Column).Value
            Sheet3.Cells(NRow, 6).Value = Sheet1.Cells(Target.Row, Target.Column + 3).Value
            Sheet3.Cells(NRow, 7).Value = Sheet1.Cells(Target.Row, Target.Column + 4).Value
            Sheet1.Activate
            Sheet1.Range("Rest").Activate
            Application.CutCopyMode = False
        End If
    End If
    Cancel = True
End Sub

Τον τροποποίησα και τον έγραψα, πολύ αναλυτικά, για να τον καταλάβεις...
Εδώ λοιπόν, βάζουμε την περιοχή που ονομάσαμε...FullName, ok?
If Intersect(Target, Sheet1.Range("FullName")) Is Nothing Then

Μετά από αυτήν την γραμμή
If Target.Value <> vbNullString Then (8η από πάνω)
Βάζουμε, κάποιες ισότητες...
Τι είναι αυτές:

Αριστερό μέρος (πριν το =)
Εκεί που θα πάει η μεταφορά (προορισμός) ...
Sheet3.Cells(NRow, 3).Value
Φύλλο.Κελί(τελευταία γραμμή, 3η κολώνα).τιμή
όπου NRow η τελευταία γραμμή.

Έτσι ορίζεις ΠΟΥ θα πάνε τα «πράγματα»

Δεξί μέρος (μετά το =)
Τι θα πάρει για να μεταφέρει και από που (αφετηρία) ...
Sheet1.Cells(Target.Row, Target.Column).Value
Φύλλο.Κελί(η γραμμή του target, η στήλη του target,).τιμή
target είναι ο στόχος, το κελί που κάνουμε το διπλό κλικ...
Τα +3, +4 κλπ δηλώνουν, πόσες στήλες μετά την στήλη του target.

Με αυτόν τον τρόπο, γράψε όσες γραμμές κώδικα θέλεις,
για να μεταφέρεις, όποιες τιμές σε βολεύουν...

Σημαντικό:
Πάντα, όταν έχουμε διπλό κλικ, δεν ξεχνάμε να βάλουμε
Cancel = True
Αν δεν το βάλουμε, ο κέρσορας μένει μέσα στο κελί και όλα γίνονται «μαντάρα»
ειδικά αν το κελί έχει τύπο...

Προαιρετικά:
Έχουμε ονομάσει
Sheet1.Range("Rest").Activate
ένα κελί Rest, για να πάει να «αράξει» το ενεργό κελί,
αφού τελειώσει ο κώδικας την δουλειά του...
Αυτό μπορείς να το αλλάξεις ή να το παραλήψεις...

Ελπίζω τώρα να τα καταφέρεις...
Δεν ξέρω, αν θα μπορέσω να είμαι στο μέλλον, τόσο αναλυτικός...

[gfevran]

Καλησπέρα,
Σπύρο οι οδηγίες που μου έδωσες είναι απόλυτα σαφείς και κατανοητές,
Και είχαν απόλυτη επιτυχία στην εφαρμογή.
Δεν ξέρω πώς να σε ευχαριστήσω για την υπομονή! και το χρόνο που αφιέρωσες,
Σου Εύχομαι να έχεις πάντα καλή υγεία μπορεί να είναι μια τετριμμένη λέξη αλλά,
όταν βγαίνει μέσα από την καρδιά έχει άλλη αξία.
Γιώργο σε ευχαριστώ και εσένα δοκίμασα και την δική σου πρόταση σε ένα,
πρόχειρο Test και δουλεύει άρτια.
Χρησιμοποίησα τη μέθοδο του Σπύρου γιατί είναι συνέχεια από ένα έργο δείγμα,
που είχε ανεβάσει στο forum και επάνω σ ‘ αυτό χτίζω σιγά σιγά τη δική μου εφαρμογή.
Σας Ευχαριστώ πολύ.
Με εκτίμηση
Γιώργος