[VBA] VBA – Εκτέλεση κώδικα από το σημείο που βρίσκεται ο κέρσορας και κάτω

[Tasos]

Καλησπέρα Θανάση!
....Ο δαίμονας του τυπογραφείου θα έλεγε κανείς..

Εγώ λέω "ο δαίμονας του Copy- Paste"

Έκανα λάθος και δημοσίευσα έναν ημιτελή κώδικα.

Δες λοιπόν στο προηγούμενο μου μήνυμα τον κώδικα στην τελική του μορφή.
Το μόνο που δε γνωρίσω είναι αν τα αποτελέσματα στις 3 τελευταίες γραμμές των συνόλων
αφορούν όλες τις γραμμές ή μόνο τις γραμμές από την επιλεγμένη και κάτω.
Και οι 2 περιπτώσεις περιλαμβάνονται στον κώδικα.

Καλή συνέχεια!

[gr8styl]

Καλησπέρα σας κύριοι.
( Άλλος Θανάσης εγώ ελπίζω να μην τα μπλέξουμε.)

Μήπως θα ήταν απλούστερο να γράψουμε απλά όλους του τύπους στην δεύτερη γραμμή και αντί της With Range("K"... End With στον κώδικα να χρησιμοποιήσουμε

Range("K2").Copy Destination:=Range("K" & FirstRow & ":K" & FinalRow)

Νομίζω ότι είναι πιο απλό από το να προσπαθούμε να γράψουμε στην VBA τις φόρμουλες σε R1C1 μορφή.

Ελπίζω να έχω καταλάβει το ζητούμενο και να μην κάνω λάθος.

Θανάσης Σ.

[Tasos]

Καλησπέρα Θανάσηδες!

Η Excel υπολογίζει πάντα σε R1C1.

Όταν η Excel "βλέπει" τύπους με κανονική μορφή (A1) θα πρέπει πρώτα να τους μετατρέψει σε R1C1 για να κάνει τον υπολογιστικό κύκλο.

Έτσι οι τύποι που χρησιμοποιούνται με μορφή R1C1 (Cell.FormulaR1C1), απαιτούν λιγότερο
χρόνο εκτέλεσης αφού δεν θα χρειαστεί να γίνει μετατροπή .
Βεβαίως δεν προγραμματίζει κανείς μας πια με τύπους R1C1 αφού όπως πολύ καλά ανέφερες δεν είναι και τόσο φιλικοί προς το χρήστη.

Στη VBA όμως, όταν αυτό επιβάλλεται, εγώ τουλάχιστον χρησιμοποιώ R1C1 (δεν έχω τις καλύτερες εμπειρίες σχετικά με τους τύπους στη VBA )

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

Πέραν από τον τον τρόπο που παρουσιάζει ο Θανάσης (devcon) μέσα από το ερώτημα του
(που οφείλω να το σεβαστώ) εγώ θα χρησιμοποιούσα συναρτήσεις XL4 και σε συνδυασμό με
ελάχιστο κώδικα θα έφτανα στο επιθυμητό αποτέλεσμα.

Δείτε ένα παράδειγμα στο συνημμένο παρακάτω (για Excel > 2003).

Φιλικά

Τάσος

[devcon]

Τάσο καλημέρα,

Σε ευχαριστώ πολύ για την άψογη και τεκμηριωμένη βοήθεια σου ‘ΣΥΓΧΑΡΗΤΗΡΙΑ’.

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

Σε ευχαριστώ για μια ακόμη φορά για την άριστη βοήθεια.

Σου εύχομαι καλημέρα και καλή δουλειά.

Θανάσης (devcon)

[devcon]

Αρχική Δημοσίευση από Tasos

Καλησπέρα Θανάση!
....Ο δαίμονας του τυπογραφείου θα έλεγε κανείς..

Εγώ λέω "ο δαίμονας του Copy- Paste"

Έκανα λάθος και δημοσίευσα έναν ημιτελή κώδικα.

Δες λοιπόν στο προηγούμενο μου μήνυμα τον κώδικα στην τελική του μορφή.
Το μόνο που δε γνωρίσω είναι αν τα αποτελέσματα στις 3 τελευταίες γραμμές των συνόλων
αφορούν όλες τις γραμμές ή μόνο τις γραμμές από την επιλεγμένη και κάτω.
Και οι 2 περιπτώσεις περιλαμβάνονται στον κώδικα.

Καλή συνέχεια!

Αγαπητέ Τάσο,

Εχθές βρέθηκα μπροστά στο ακόλουθο πρόβλημα.
Σε κάποια κελιά (Unit price column “I”) χρειάσθηκε να βάλω χειροκίνητα τις τιμές και μετά έδωσα την μακρο-εντολή για να συμπλήρωση όλα τα υπόλοιπα κελιά και να κάνει τις πράξεις. Δυστυχώς η μακρο-εντολή μου ακύρωσε τις τιμές που είχα τοποθετήσει χειροκίνητα.

Σε παρακαλώ θα ήθελα να με βοηθήσεις οι πράξεις να γίνονται ως αναφέρεις ανωτέρω με την διαφορά ότι όταν βρίσκει ένα κελί με νούμερο να το μεταπηδά (skip cells) και να συνεχίζει στα υπόλοιπα κενά κελιά.

Ελπίζω να σου έδωσα να καταλάβεις το πρόβλημά μου.

Σε ευχαριστώ εκ των προτέρων για την βοήθεια σου.
Θανάσης (devcon)

[Tasos]

Καλημέρα Θανάση!

Όπως ανέφερα σε προηγούμενο μου μήνυμα, η τακτική με την αντιγραφή τύπων δεν με βρίσκει σύμφωνο αλλά αυτό είναι δική σου επιλογή.

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

Απενεργοποιείς λοιπόν όλα τα " .Value = .Value " για να μπορέσει η Εφαρμογή να εντοπίσει τις σταθερές που έχεις πληκτρολογήσει (πάνω στους τύπους!!) και να τις υπερπηδήσει.
Παράλληλα, θα χρειαστούν αρκετές τροποποιήσεις στον κώδικα.

Όμως:
Ας πούμε ότι το κάνεις αυτό μια δυο φορές χρησιμοποιώντας έναν τροποποιημένο κώδικα.

1. Δεν θα είναι ξεκάθαρο σε ποια κελιά έχει επέμβει ο χρήστης.
Θα πρέπει να είσαι σε θέση να διακρίνεις που έχεις κάνει αλλαγές!.
Πως θα διακρίνεις τις δικές σου αλλαγές αφού δε διαφέρουν οπτικά από τους τύπους;

2. Επαναφορά τύπων
Τι θα κάνεις αν μετά από κάποιες πληκτρολογήσεις θελήσεις οι σταθερές αυτές να ξαναπάρουν την αρχική τους μορφή (τύπους);

Θα μπορούσες φυσικά να χρησιμοποιήσεις και τον αρχικό κώδικα (αυτόν που χρησιμοποιήσεις τώρα αφαιρώντας όμως τα " .Value = .Value ")
για επαναφέρεις όλους τους τύπους.

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

Παράδειγμα:

• Η στήλη "I" ("Unit Price" ) περιέχει τους τύπους.
• Η στήλη "J" που θα προσθέσεις ( θα γίνει στήλη "J" ) θα είναι κενή, ίσως με διαφορετικό χρώμα γραμματοσειράς για να ξεχωρίζει.

Ο τύπος στη στήλη "I" θα είναι:

=IF(J10<>"";J10;IFERROR(ROUND(L10*(1+Owners%);2); "")) όπου IFERROR(ROUND(L10*(1+Owners%);2); "") = ο αρχικός τύπος.

Μ αυτό τον τρόπο, πληκτρολογείς στην κενή στηλη ( "J" ) και η τιμή εμφανίζεται αυτόματα στη στήλη "I" ("Unit Price" ).

Νομίζω ότι έτσι το ελέγχεις καλύτερα.

Αν παρόλα αυτά νομίζεις ότι η VBA είναι απαραίτητη (κάνεις κατάχρηση της VBA )
τότε να σε βοηθήσουμε να μετατρέψεις τον κώδικα.

Με εκτίμηση


Τάσος

[devcon]

Τάσο καλημέρα,

Σου ζητώ συγνώμη για τα προβλήματά μου και ελπίζω στην κατανόηση σου.

‘Έχεις απόλυτο δίκιο αλλά στο πραγματικότητα είναι πολλές φορές που ο πελάτης προσπαθεί με τον ένα ή τον άλλο τρόπο να σου ζητήσει να κατεβάσεις κάποιες τιμές για να πάρεις την παραγγελία. Έτσι είμαι υποχρεωμένος να αλλάξω χειροκίνητα κάποιες τιμές από την προσφορά που του έκανα.
Η θεωρία σου για την εισαγωγή μιας επιπλέον στήλης είναι πολύ καλή και θα μου έλυνε το πρόβλημα. Επίσης έχεις την δυνατότητα με μια ματιά να βλέπεις τις αλλαγές τις οποίες έκανες. Εάν και αυτό θα μου δημιουργήσει κάποιες άλλες αλλαγές στην εισαγωγή των δεδομένων στην Access, αλλά αυτό λύνεται, δεν νομίζω ότι είναι δύσκολο.

Τώρα ως προς την φόρμουλα
=IF(J10<>"";J10;IFERROR(ROUND(L10*(1+Owners%);2); ""))
δεν την δέχεται δίνει Error είτε στο λογισμικό φύλλο ή στην VBA.

Μήπως υπάρχει κάποιο λάθος στην φόρμουλα;
Σε ευχαριστώ για την κατανόησή σου.

Θανάσης

Sub Offer()

    Dim FirstRow As Long, FinalRow As Long, CalcRows As Long
    FirstRow = ActiveCell.row
    FinalRow = Cells(Rows.Count, 2).End(xlUp).row
    CalcRows = FinalRow - FirstRow + 1
    
    'Create Names
    
    ActiveWorkbook.Names.Add Name:="Owners", RefersToR1C1:= _
        "='Request For Quotations'!R2C15"
    ActiveWorkbook.Names("Owners").Comment = ""
    'Range("P2").Select
    ActiveWorkbook.Names.Add Name:="Supplier", RefersToR1C1:= _
        "='Request For Quotations'!R2C16"
    ActiveWorkbook.Names("Supplier").Comment = ""

    
    ' Message Box
Range("O2") = Application.InputBox("Owners")
'Range("O2").Select
    Range("P2") = Application.InputBox("Supplier")
'Range("P2").Select
    
    If Not IsNumeric(Range("O2")) Or IsEmpty(Range("Owners")) _
       Or Not IsNumeric(Range("P2")) Or IsEmpty(Range("Supplier")) Then
        ' Code will exit. Show some message...
        Exit Sub
    End If
    If CalcRows < 1 Then
        'Can not be a valid Range... Show some message...
    End If

    Application.ScreenUpdating = False
    ' Cost Net
    With Range("L" & FirstRow & ":L" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-1]<>"""",ROUND(RC[-1]*(1-Supplier%),2),"""")"
       ' .Value = .Value    'Convert Formulas to Values
    End With
    '   Unit Price

    With Range("I" & FirstRow & ":I" & FinalRow)
         .FormulaR1C1 = "=IF(J3<>"";J3;IFERROR(ROUND(L3*(1+Owners%);2); """"))"
         .Value = .Value
    End With

    ' Total Cost
    With Range("M" & FirstRow & ":M" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-4]*RC[-1],"""")"
       ' .Value = .Value
    End With

    ' Total Sales
    With Range("N" & FirstRow & ":N" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-4]<>"""",RC[-5]*RC[-4],"""")"
       ' .Value = .Value
    End With

    ' Enter the Total Row
    FirstRow = FinalRow - 2

    Range("L3").Copy
    With Range("L" & FinalRow + 1).Resize(4, 3)
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        .Font.Bold = True
        .Font.Italic = True
        With .Resize(1, 3)

' Sum from selected Row________________________________

            '.Item(1).Value = "Total"
            '.Item(2).FormulaR1C1 = "=SUM(R[-" & CalcRows & "]C:R[-1]C)"
            '.Item(3).Formula = "=SUM(R[-" & CalcRows & "]C:R[-1]C)"
            '.Font.ColorIndex = xlAutomatic
            'With .Offset(1).Resize(3, 3)
             '   .Item(1).Value = "Profit"
             '   .Item(3).FormulaR1C1 = "=SUM(R[-" & CalcRows + 1 & "]C:R[-2]C)- SUM(R[-" & CalcRows + 1 & _
                                       "]C[-1]:R[-2]C[-1])"
             '   .Item(4).Value = "P/C"
             '   .Item(6).FormulaR1C1 = "=(SUM(R[-" & CalcRows + 2 & "]C:R[-3]C)- SUM(R[-" & CalcRows + 2 & _
                                       "]C[-1]:R[-3]C[-1]))/(SUM(R[-" & CalcRows + 2 & "]C[-1]:R[-3]C[-1]))"
             '   .Item(6).NumberFormat = "0.00%"
             '   .Item(7).Value = "P/S"
             '   .Item(9).FormulaR1C1 = "=(SUM(R[-" & CalcRows + 3 & "]C:R[-4]C)- SUM(R[-" & CalcRows + 3 & _
                                       "]C[-1]:R[-4]C[-1]))/(SUM(R[-" & CalcRows + 3 & "]C:R[-4]C))"
             '   .Item(9).NumberFormat = "0.00%"
             '   .Font.ColorIndex = 41&
            'End With
           
           ' Sum from the first Row__________________________________________

            .Item(1).Value = "Total"
            .Item(2).FormulaR1C1 = "=SUM(R[-" & FirstRow & "]C:R[-1]C)"
            .Item(3).Formula = "=SUM(R[-" & FirstRow & "]C:R[-1]C)"
            .Font.ColorIndex = xlAutomatic
            With .Offset(1).Resize(3, 3)
                .Item(1).Value = "Profit"
                .Item(3).FormulaR1C1 = "=SUM(R[-" & FirstRow + 1 & "]C:R[-2]C)- SUM(R[-" & FirstRow + 1 & _
                                       "]C[-1]:R[-2]C[-1])"
                .Item(4).Value = "P/C"
                .Item(6).FormulaR1C1 = "=(SUM(R[-" & FirstRow + 2 & "]C:R[-3]C)- SUM(R[-" & FirstRow + 2 & _
                                       "]C[-1]:R[-3]C[-1]))/(SUM(R[-" & FirstRow + 2 & "]C[-1]:R[-3]C[-1]))"
                .Item(6).NumberFormat = "0.00%"
                .Item(7).Value = "P/S"
                .Item(9).FormulaR1C1 = "=(SUM(R[-" & FirstRow + 3 & "]C:R[-4]C)- SUM(R[-" & FirstRow + 3 & _
                                       "]C[-1]:R[-4]C[-1]))/(SUM(R[-" & FirstRow + 3 & "]C:R[-4]C))"
                .Item(9).NumberFormat = "0.00%"
                .Font.ColorIndex = 41&
            End With
        '    .Value = .Value 'Convert Formulas to Values

        End With
    End With
    Application.ScreenUpdating = True
End Sub