Προς το περιεχόμενο

Excel - VBA If condition


Προτεινόμενες αναρτήσεις

Δημοσ.

Οι γνώσεις μου είναι στοιχειώδεις στο VBA αλλά νομίζω ότι αυτό που θέλω είναι αρκετά απλό.

Έχω ένα Drop down list στο excel από το οποίο μπορείς να επιλέξεις 5 τιμές.

Επίσης έχω τα κελιά Α11:D18 merge ώστε να γράφει κείμενο ο χρήστης.

Θέλω όταν στην Drop down list επιλέξω πχ την πρώτη τιμή, τότε τα merge cells να γίνονται unmerge και να αντιγράφουν τις τιμές από ένα άλλο φύλλο.

Αν μπορεί κάποιος να με βοηθήσει θα είμαι ευγνώμον.

Αν αυτό δεν γίνεται, θα εξυπηρετούσε ως εναλλακτική να γίνεται το ίδιο με ένα button, το οποίο όταν το πατάω να κάνει αυτή τη δουλειά και όταν το ξαναπατάω να κάνει merge αυτά τα κελια

Ευχαριστώ εκ των προτέρων  

Δημοσ.

Μήπως κάποιος έχει κάτι παρεμφερές να προτείνει για να με βοηθήσει ;  με δύο κουμπιά, με τρία , έστω με 4 ρε παιδια ! 

Δημοσ.

Βασικός κανόνας όταν δουλεύεις με VBA. Αν θες να δεις τον κώδικα μιας απλής ενέργειας, που δεν γνωρίζεις, όπως η συγχώνευση ή αποσυγχώνευση κελιών τα κάνεις χεράτα με τον Macro recorder να καταγράφει και βλέπεις τι κατέγραψε και τι θες να κρατήσεις από αυτό.

Π.χ.

Sub macro1()

    Range("A11:D18").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge


    Range("A11:D18").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.UnMerge
End Sub

Δεν είναι πάντα αναγκαίο να τεθούν τιμές για όλες τις properties που βλέπεις παραπάνω.

Τα υπόλοιπα έχουν να κάνουν με event oriented programming. Δηλαδή να τρέχει συγκεκριμένος κώδικας όταν συμβεί κάτι συγκεκριμένο, όπως η αλλαγή τιμής κάποιου του κελιού στο συγκεκριμένο φύλλο.

Διαλέγεις το εν λόγω φύλλο του excel και στο παράθυρο του κώδικα από το αριστερό drop down list διαλέγεις Worksheet(για κώδικα σε επίπεδο φύλλου). Ενώ στο δεξί επιλέγεις Change. Και γράφεις-πρόχειρα-κάτι τέτοιο:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo errorhandler  'Όταν συμβεί σφάλμα π.χ. επιλογή και διαγραφή μιας ολόκληρης στήλης πάει στον error handler που τερματίζει την procedure.
If Target <> ActiveSheet.Range("E1") Then
    Exit Sub

End if

Τερματίζει επίσης την procedure αν το κελί που άλλαξε δεν είναι το ζητούμενο κελί, έστω E1.

If Target.Value = "ena" Then 'Έστω ena η τιμή που θέλουμε να κάνει unmerge τα κελιά.
        Range("A11:D18").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.UnMerge
Else
    Range("A11:D18").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
End If

errorhandler:
    Exit Sub

Τα υπόλοιπα είναι copy paste τιμών από το κελί του φύλλου που θες στο πρώτο φύλλο που έχει το πινακάκι σου. Δοκίμασε να κάνεις copy-paste τιμές με macro recorder να δεις τον κώδικα. Ή κάνεις αντιστοίχιση και την βάζεις να τρέξει στο κομμάτι της παραπάνω μεγάλης IF που θες. Π.χ.:

ActiveSheet.Range("G1").Value = Worksheets(2).Range("A1").Value

  • Like 2

Δημιουργήστε ένα λογαριασμό ή συνδεθείτε για να σχολιάσετε

Πρέπει να είστε μέλος για να αφήσετε σχόλιο

Δημιουργία λογαριασμού

Εγγραφείτε με νέο λογαριασμό στην κοινότητα μας. Είναι πανεύκολο!

Δημιουργία νέου λογαριασμού

Σύνδεση

Έχετε ήδη λογαριασμό; Συνδεθείτε εδώ.

Συνδεθείτε τώρα
  • Δημιουργία νέου...