Excel - VBA drop down list + event oriented programming

[ffilz]

Καλησπέρα,

Οι γνώσεις μου είναι στοιχειώδεις στο VBA και θα το εκτιμούσα αν με βοηθούσε κάποιος. 

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

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

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

Όταν στο ίδιο φύλλο επιλέξει κάποια από τις υπόλοιπες τιμές, τότε παλι τα κελιά Α11:Α18 να γίνονται merge για την εισαγωγή κειμένου. 

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

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

Αν πάλι πιστεύετε ότι είναι πολύ πιο δύσκολο από ό,τι φαντάζομαι, θα με βοηθούσε να μου το πείτε, μήπως βρω κάποιον να του στείλω το excel να τον πληρώσω να μου το φτιάξει

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

Επεξ/σία 5 Φεβρουαρίου 2021 από ffilz

[virxen75]

στείλε ένα αρχείο excel με αυτό που ζητάς

[ffilz]

 

@virxen75 ανέβασα το excel 

έχω προσθέσει ένα sheet "Data (2) " το οποίο είναι ουσιαστικά το πως θέλω να διαμορφωθεί το sheet "Data " αν επιλέξει κάποιος στην drop down list πάνω δεξιά την επιλογή "Margin ". Σε όλες τις άλλες επιλογές θέλω να είναι απλά ένα Merge κελί για εισαγωγή κειμένου. 

Σε ευχαριστώ προκαταβολικά 

=Tool Z V210121.xlsx

Επεξ/σία 5 Φεβρουαρίου 2021 από ffilz

[pirmen56]

@ffilz 

Θα φτιάξεις νέο φύλλο που θα έχεις αντιγράψεις όλο το data(2) σβήνοντας τα πάντα γύρω από το πινακάκι σου ώστε να ξεκινάει από το A1. Είναι καλύτερο να αντιγράφεις έτοιμα τα formats παρά να τα περνάς με κώδικα. Ονόμασέ το π.χ. formats.

Θα μπεις στο VBA περιβάλλον και θα φτιάξεις ένα νέο module και θα ρίξεις μέσα τον παρακάτω κώδικα. Το μεγαλύτερο μέρος(εκτός το Γέμισμα με τιμές) φτιάχνεται αυτόματα όπως σου είχα πει με τον macro recorder:

Sub unmerge_cells()
    
    'Μεταφορά μορφοποίησης
    
    Sheets("Formats").Select
    Range("A1:Q25").Select
    Selection.Copy
    Sheets("Demo").Select
    Range("B22:R46").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.DisplayGridlines = False

    'Γέμισμα με τιμές
    
    Sheets("demo").Range("B22").Value = "L3869 NPV"
    Sheets("demo").Range("I22").Value = "L3869 NPV"
    Sheets("demo").Range("B23").Formula = "=Scenarios!G4"
    Sheets("demo").Range("I23").Formula = "=BF15"
    
    Dim cA As Integer
    Dim cB As Integer
    Dim i As Integer
    Dim keimA As String
    Dim keimB As String
    seira = Array("B", "E", "H", "K", "N")
    
    For i = 0 To 4
        For cA = 25 To 46
            cB = cA - 18 + i * 22
            keimA = seira(i) & cA
            keimB = "E" & cB
            Sheets("Demo").Range(keimA).Formula = "=Scenarios!E" & cB
        Next cA
    Next i
    
    Sheets("demo").Select

End Sub


Sub merge_cells()

    Application.DisplayAlerts = False
 
    Sheets("demo").Select
    Range("B22:R46").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Source Sans Pro"
        .FontStyle = "Regular"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDot
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDot
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDot
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDot
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ClearContents
    
    Application.DisplayAlerts = True

End Sub

Μετά από τον explorer της VBA(πάνω αριστερά παράθυρο) θα διαλέξεις το φύλλο που έχει το πινακάκι σου. Δηλαδή θα μπεις μέσα στο φύλλο. Θα επιλέξεις worksheets από το αριστερό drop down list(ψηλά) και Change από το δεξί.

Θα βγάλει κάτι τέτοιο:

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

Θα τα σβήσεις όλα και θα περάσεις το παρακάτω:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo errorhandler
If Target <> ActiveSheet.Range("Y5") Then
    Exit Sub
End If

If Target.Value = "Margin [75k – 100k]" Then
    Call unmerge_cells
Else
    Call merge_cells
End If

errorhandler:

End Sub

Όπου demo βάζεις το όνομα του φύλλου.

[ffilz]

@PIrmne56 σε ευχαριστώ πολύ 

θα το προσπαθήσω και θα σου πω. Ελπίζω σε happy end