Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Διαγραφή δεδομένων με βάση λίστα.

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #11  
Παλιά 07-10-12, 18:54
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 05-02-2010
Μηνύματα: 196
Προεπιλογή

Σπύρο παρουσιάζει και πάλι το ίδιο πρόβλημα
=IF(#ΑΝΑΦ!="";T3;#ΑΝΑΦ!) και =IF(AND(#ΑΝΑΦ!="";#ΑΝΑΦ!="");"End of List";T3&" "&#ΑΝΑΦ!)
βγάζει #ΑΝΑΦ! Στα κελιά που διαγράφουμε.
Απάντηση με παράθεση
  #12  
Παλιά 07-10-12, 21:47
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.321
Προεπιλογή

Γιώργο φυσικό είναι να βγάζει #ΑΝΑΦ
Εφ' όσον διαγράφουμε περιοχές που "παίρνουν" οι τύποι
Πρέπει λοιπόν να τους ξαναχτίσουμε
Ονόμασε 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
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm Kinoxista 1,3 test1.1.xlsm (66,5 KB, 35 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη Spirosgr : 07-10-12 στις 22:45.
Απάντηση με παράθεση
  #13  
Παλιά 08-10-12, 08:03
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.321
Προεπιλογή

Τελικά για καλύτερα αποτελέσματα μπορείς να βάλεις αυτό
όπου έχουν χρησιμοποιηθεί οι κωδικές ονομασίες των φύλλων
ώστε και να αλλάξει κάποιος το όνομα του φύλλου να μην επηρεάζει τον κώδικα
Ονόμασε πίσω από την 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
Απάντηση με παράθεση
  #14  
Παλιά 08-10-12, 14:50
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 05-02-2010
Μηνύματα: 196
Προεπιλογή

Καλησπέρα Σπύρο και σε όλους
Μόλις άνοιξα και βλέπω ότι έκανες πολύ δουλεία στα δυο τελευταία ποστ.
Μόλις τελειώσω με το φαγητό θα τα δω.
Με την πρώτη ματιά μου φαίνετε λίγο δύσκολο να κατανοήσω τι ακριβώς κάνουν και πως.
Θα προσπαθήσω, θα μου πάρει λίγη ώρα.
Ευχαριστώ και πάλι.
Γιώργος
Απάντηση με παράθεση
  #15  
Παλιά 23-10-12, 19:55
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 05-02-2010
Μηνύματα: 196
Προεπιλογή

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


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
Διαγραφή δεδομένων anestaki Access - Ερωτήσεις / Απαντήσεις 0 28-12-15 20:43
[VBA] Διαγραφή δεδομένων gfevran Excel - Ερωτήσεις / Απαντήσεις 10 10-05-14 20:06
[Συναρτήσεις] Αναζήτηση και Εκτύπωση Δεδόμενων απο Βάση Δεδομένων nakosg Excel - Ερωτήσεις / Απαντήσεις 9 01-02-13 19:34
Διαγραφή Δεδομένων από Πινάκα synti Access - Ερωτήσεις / Απαντήσεις 6 04-04-11 23:58
[VBA] διαγραφή δεδομένων misirlis Excel - Ερωτήσεις / Απαντήσεις 7 28-11-10 20:52


Η ώρα είναι 21:28.