Forum - VBA Διαγραφή δεδομένων με βάση λίστα.

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Διαγραφή δεδομένων με βάση λίστα. (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2099-diagrafi-dedomenon-me-basi-lista.html)

Διαγραφή δεδομένων με βάση λίστα.

Καλησπέρα σε όλους
Θα ήθελα και πάλι την βοήθεια σας.
Από την αρχική και με το κουμπί (Διαγραφή δεδομένων) θέλω να διαγράψω: από το Αρχείο και με βάση την λίστα Monthlist6 όλες τις γραμμές από το Χρεώσεις με βάση την λίστα lista όλες της γραμμές και από το Κατανομή με βάση την λίστα monthlist όλες της γραμμές .
Στο Κατανομή επίσης αντιγραφή το (t2)και επικόλληση σε όλη την στήλη και το ίδιο για την (u2),και διαγραφή του κουμπιού από την αρχική.

Καλησπέρα
Φίλε Γιώργο το ζητούμενο βγαίνει με έναν σχετικά εύκολο κώδικα
ΑΛΛΑ δεν κατάλαβα το τελευταίο κομμάτι από το ζητούμενο
Όταν τελειώσεις με διαγραφές και αντιγραφές το κουμπί το καταργείς από το φύλλο;
Δεν το θέλεις άλλο; ή κάτι δεν κατάλαβα καλά ...

Καλησπέρα Σπύρο
Ναι να καταργηθεί δηλαδή μιας χρίσης.

Φίλε μου δεν αξίζει τον κόπο να κάνουμε όλη την διαδικασία με κώδικες για μια φορά
καν' το με το "χέρι"

Φιλέ Σπύρο το συγκεκριμένο excel το χρησιμοποιούν και άλλη από το λινκ Πρόγραμμα καταμονής κοινοχρήστων και όταν χρειάζεται να διαγράψουν γραμμές και να επικολλήσουν κελία είναι αρκετά δύσκολο να τους το εξηγείς κάθε φορά

Γιώργο τεχνικά δεν μπορούμε να βασιστούμε στο "όνομα" της κάθε λίστας απ' αυτές που αναφέρεις γιατί δεν είναι δυναμικές
Αν αλλάξει το μήκος τους δεν θα γίνει σωστή δουλειά
Λόγω προχωρημένης ώρας άσε να το δω το πρωί...

Σπύρο σε ευχαριστώ εκ’ των προτέρων

Καλημέρα
Στο φύλλο που ακολουθεί υπάρχει παραδειγματικά το πιο πάνω ζητούμενο.
Μπορεί να το προσαρμόσει ο καθ' ένας στις ανάγκες του.
Οι πληροφορίες και ο κώδικας είναι πολύ αναλυτικά γραμμένα και δεν νομίζω να υπάρξει δυσκολία.
Καλή συνέχεια!

Παρουσιάζει το σφαλά

Kαλησπέρα Σπύρο
Σε ευχαριστώ όλες οι εντολές διαγραφής δουλεύουν μια χαρά έκτος από το αντιγραφή και επικόλληση. Παρουσιάζει το σφαλά =IF(#ΑΝΑΦ!="";T3;#ΑΝΑΦ!) και =IF(AND(#ΑΝΑΦ!="";#ΑΝΑΦ!="");"End of List";T3&" "&#ΑΝΑΦ!) όταν είναι τύπος
όταν είναι κείμενο επικολλά απλός το κείμενο IF(B3="";T3;B3) και IF(AND(B3="";E3="");"End of List";T3&" "&B3)

Γιώργο αφού υπάρχει τύπος αφαίρεσε το κομμάτι αντιγραφής επικόλλησης
και στην θέση του βάλε αυτό (προσαρμοσμένο φυσικά)

Range("Sheet2! L3:M25").Formula = Range("Sheet2! L2:M2").Formula

Σπύρο παρουσιάζει και πάλι το ίδιο πρόβλημα
=IF(#ΑΝΑΦ!="";T3;#ΑΝΑΦ!) και =IF(AND(#ΑΝΑΦ!="";#ΑΝΑΦ!="");"End of List";T3&" "&#ΑΝΑΦ!)
βγάζει #ΑΝΑΦ! Στα κελιά που διαγράφουμε.

Γιώργο φυσικό είναι να βγάζει #ΑΝΑΦ
Εφ' όσον διαγράφουμε περιοχές που "παίρνουν" οι τύποι
Πρέπει λοιπόν να τους ξαναχτίσουμε
Ονόμασε T1=mycell1 και U1=mycell2
Πέρασε από την αρχή αυτόν τον κώδικα στο Module διαγράφοντας όλα τα άλλα.

Κώδικας:

Sub CountandDelete()

    Dim i As Integer, Button2 As Shape

    If MsgBox("Το κείμενό σου", _

              vbYesNo + vbQuestion + vbDefaultButton2) <> vbYes Then

        Exit Sub

    End If

    Application.ScreenUpdating = False

    i = Range("Αρχείο! b" & Rows.Count).End(xlUp).Row

    If i > 3 Then Range("Αρχείο! A4:aq" & i).Delete Shift:=xlUp

    i = Range("Χρεώσεις! b" & Rows.Count).End(xlUp).Row

    If i > 2 Then Range("Χρεώσεις! A3:ah" & i).Delete Shift:=xlUp

    i = Range("Κατανομή! b" & Rows.Count).End(xlUp).Row

    If i > 2 Then Range("Κατανομή! A3:s" & i).Delete Shift:=xlUp

    Range("mycell1").FormulaR1C1 = "=iferror(IF(R[2]C[-18]="""",R[1]C,R[2]C[-18]),"""")"

    Range("mycell2").FormulaR1C1 = _

    "=iferror(IF(AND(R[2]C[-19]="""",R[2]C[-16]=""""),""End of List"",R[2]C[-1]&"" ""&R[2]C[-16]),"""")"

    Range("Κατανομή! t3:u500").Formula = Range("Κατανομή! t1:u1").Formula

    MsgBox ("Όλες οι εντολές  ολοκληρώθηκαν με επιτυχία!"), vbInformation, "SpirosgrInfo"

End Sub

Έχει τσεκαριστεί και λειτουργεί κανονικά
επίσης στον προηγούμενο κώδικα αντέγραφες το T1 και U1 σε T3 και U2 (αντί U3) οπότε και οι τύποι έπαιρναν από άλλες μεριές
ΥΓ
Ξέχασα στον κώδικα την γραμμή που διαγράφει το κουμπί
Πέρασέ την πριν το τελευταίο msgbox

Τελικά για καλύτερα αποτελέσματα μπορείς να βάλεις αυτό
όπου έχουν χρησιμοποιηθεί οι κωδικές ονομασίες των φύλλων
ώστε και να αλλάξει κάποιος το όνομα του φύλλου να μην επηρεάζει τον κώδικα
Ονόμασε πίσω από την vba το φύλλο Αρχική ....shStart
Ακόμα έχουν ονομαστεί οι περιοχές T3:T500 & U3:U500
Για να λειτουργήσει η διαγραφή του κουμπιού πρέπει το φύλλο αρχική να είναι ξεκλειδωμένο

Κώδικας:

Sub CountandDelete()

    Dim i As Integer

    If MsgBox("Το κείμενό σου", _

              vbYesNo + vbQuestion + vbDefaultButton2) <> vbYes Then

        Exit Sub

    End If

    Application.ScreenUpdating = False

    i = ShArchive.Range("b" & Rows.Count).End(xlUp).Row

    If i > 3 Then ShArchive.Range("A4:aq" & i).Delete Shift:=xlUp

    i = xreosis.Range("b" & Rows.Count).End(xlUp).Row

    If i > 2 Then xreosis.Range("A3:ah" & i).Delete Shift:=xlUp

    i = katanomi.Range("b" & Rows.Count).End(xlUp).Row

    If i > 2 Then katanomi.Range("A3:s" & i).Delete Shift:=xlUp

    katanomi.Range("rngFormula1").FormulaR1C1 = "=iferror(IF(R[2]C[-18]="""",R[1]C,R[2]C[-18]),"""")"

    katanomi.Range("rngFormula2").FormulaR1C1 = "=iferror(IF(AND(R[2]C[-19]="""",R[2]C[-16]=""""),""End of List"",R[2]C[-1]&"" ""&R[2]C[-16]),"""")"

    shStart.Shapes(Application.Caller).Delete

    MsgBox ("Όλες οι εντολές  ολοκληρώθηκαν με επιτυχία!"), vbInformation, "SpirosgrInfo"

End Sub

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

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