Ανανέωση ιστοσελίδας

[jockey17]

Καλησπέρα σε όλη την παρέα του φόρουμ.

Θέλω να αντικαταστήσω τον πολλαπλασιασμό που αποτελεί μέρος ενός τύπου με το γινόμενο του, το αποτέλεσμα του δηλαδή, σε όσα κελιά περιέχουν τύπους αφήνοντας τις υπόλοιπες πράξεις του τύπου ως έχει. Μόνο όπου έχει πολλαπλασιασμό θέλω να κάνω αυτή την αντικατάσταση.
Για παράδειγμα σε ένα κελί έχω:
Τον τύπο “=12*15+22*32” και θέλω να μετατραπεί σε “=180+704”.
Όπως θα δείτε στο συνημμένο αρχείο έχω προχωρήσει μέχρι του σημείου να έχω χωρίσει την αρχική συνάρτηση σε τμήματα, αλλά δεν έχω καταφέρει να την ξανά «συναρμολογήσω». Έχω κολλήσει με το αποτέλεσμα του πολλαπλασιασμού γιατί μετά από αυτό πιστεύω πως θα μπορούσα να συνεχίσω με την «συναρμολόγηση» της. Στο αρχείο μου θεωρώ ότι εκτός από τον πολλαπλασιασμό υπάρχει μόνο η πρόσθεση από τις υπόλοιπες πράξεις.
Μπορεί κάποιος να με βοηθήσει;
Ευχαριστώ εκ των προτέρων.
Φιλικά
Δημήτρης

Σημείωση: Αντί για το debug.print χρησιμοποιώ τα msgbox για να βλέπω, εάν το σκεπτικό μου προχωράει αναλόγως και στον κώδικα.

[kapetang]

Καλημέρα

Δημήτρη δες μια πρόταση στο συνημμένο αρχείο.

Φιλικά/Γιώργος

[jockey17]

Καλησπέρα Γιώργο και σε ευχαριστώ για την άμεση ανταπόκριση.
Ήθελα να σε ρωτήσω, εάν αυτό που είχα γράψει εγώ θεωρείς, ότι ήταν στη σωστή κατεύθυνση κι ενδεχομένως εκεί που εντοπίζονται οι αριθμοί που αποτελούν τα τμήματα για τον πολλαπλασιασμό θα μπορούσε με κάποιο τρόπο να συνεχίσει κανείς βάζοντας για παράδειγμα στο σημείο του loop:
FormulaMultiSplit = Split(FormulaWithMultiToSplit, "*")
For FormulaOnlyMultiParts = LBound(FormulaMultiSplit) To UBound(FormulaMultiSplit)
PartResult = CLng(FormulaMultiSplit(FormulaOnlyMultiParts))
Next
Κάποιο array έτσι ώστε να κρατάει προσωρινά τις τιμές έως ότου να τις κάνει πράξεις όπως αυτό που κάνεις με το Application.Evaluate, το οποίο παρεμπιπτόντως δεν το γνώριζα και το έψαξα λίγο για να το καταλάβω. Αυτά έτσι για γενική επιμόρφωση.
Ο κώδικας σου σαφώς είναι λιτός και συνάμα περιεκτικός. Δεν το συζητάω, ότι στοχεύει απ’ ευθείας στον στόχο. Μου πήρε λίγη ώρα μέχρι να τον καταλάβω, επειδή δεν έχω και την ανάλογη πείρα, αλλά μου έγινε πλήρες κατανοητός. Το θέμα είναι ότι φαντάστηκα πως εάν το κατάφερνα όπως αρχικά το ξεκίνησα, ήθελα να το συνεχίσω ως εξής:
- Οποιαδήποτε άλλη συνάρτηση που δεν περιέχει πολλαπλασιασμό ή ας το πω αλλιώς: συνάρτηση που εμπεριέχει το «-» για αφαίρεση ή την «/» για διαίρεση θέλω εξ’ αρχής να αγνοείται και να μένει ανέπαφη (Δεν είναι κελιά που καταχωρεί ο χρήστης).
- Η περιοχή στην οποία θα εφαρμόζεται η ρουτίνα θα βρίσκεται σε άλλο αρχείο, στο οποίο δεν μπορώ να προσθέσω κώδικα. Έτσι το δοκίμασα και με το υπάρχων InputBox και έπαιξε κανονικά, αφού πρώτα δοκίμασα σε ένα κελί να πάρω την περιοχή όπως την καταλαβαίνει το excel. Δηλαδή βάζοντας ένα ίσον και υποδεικνύοντας την περιοχή έλαβα π.χ. το «=[Book1]Sheet1!$A$1:$A$15» και αυτό επικόλλησα τόσο στο πρώτο InputBox όσο και στο δεύτερο και έπαιξε.
- Τέλος και σημαντικότερο είναι ότι εάν θέλω να υποδείξω με μίας μία ολόκληρη στήλη ή μία ευρύτερη περιοχή, αυτή δυστυχώς εμπεριέχει και κλειδωμένα κελιά και ότι και εάν εμπεριέχουν αυτά, σαφώς θα πρέπει να αγνοούνται.
Δεν ξέρω εάν μπορείς να δώσεις κάποια κατεύθυνση για όλα τα παραπάνω.
Φιλικά
Δημήτρης

[jockey17]

Σχετικά με τα κλειδωμένα κελιά πρόσθεσα στον κώδικα:
If rngSource.Cells(i, j).Locked = False Then
…. Ο κώδικας όπως τον έγραψες….
Else
End If
Και διαπίστωσα ότι αυτά που είναι κλειδωμένα είναι και οι περιπτώσεις να έχουν αφαίρεση ή διαίρεση. Βέβαια θα πειραματιστώ ακόμα, σε περίπτωση που υπάρχουν και άλλα κελιά ξεκλείδωτα με αφαίρεση ή διαίρεση.
Σημείωση: στο «And IsNumeric(Mid(rngSource.Cells(i, j).Formula, 3, 1))», το 3 μάλλον πρέπει να είναι 2;
φιλικά
Δημήτρης

[jockey17]

Επίσης πρόσθεσα στις συνθήκες για να εκτελέσει τις ενέργειες:
If rngSource.Cells(i, j).Locked = False And InStr(rngSource.Cells(i, j).Formula, "-") = 0 And InStr(rngSource.Cells(i, j).Formula, "/") = 0 Then
… ο κώδικας ….
Else
End If

Δεν ξέρω εάν συμφωνείς ή έχεις κάτι άλλο να προτείνεις.
Φιλικά / Δημήτρης

[kapetang]

Καλησπέρα/Καλημέρα

Δημήτρη δες μια άλλη λύση στο επισυναπτόμενο αρχείο.

Όλη τη δουλειά την κάνει μία αναδρομική συνάρτηση (συνάρτηση που καλεί επανειλημμένα τον εαυτό της).

Είναι γενικότερη και τη θεωρώ πολύ καλύτερη.

Κάνε δοκιμές με διάφορες περιπτώσεις για να δεις τα αποτελέσματα που δίνει και να ξεκαθαρίσεις πότε θα καλείται από τη ρουτίνα.

Φιλικά/Γιώργος

[jockey17]

Καλησπέρα Γιώργο,
Σε ευχαριστώ για την νέα λύση που έφτιαξες. Με βάζεις συνεχώς σε «βαθύτερα νερά», αφού αντιλαμβάνομαι τι κάνει η ρουτίνα, αλλά ακόμα τη μελετώ για να την κατανοήσω καλύτερα. Σαφώς είναι καλύτερη επειδή είναι γενικότερη και όσο τη δοκίμασα δεν διαπίστωσα κανένα πρόβλημα. Μάλιστα την χρησιμοποίησα live σε αρχείο στη δουλειά, του οποίου ένα μικρό απόσπασμα αντέγραψα στο «Sheet2». Το φύλλο το κλείδωσα (χωρίς κωδικό), όπως είναι κλειδωμένο και στο αρχείο στη δουλειά. Σε αυτό το φύλλο γίνονται καταγραφές παραγγελιών, όπου σε κάποιες περιπτώσεις η απεικόνιση οφείλει να γίνεται «ποσότητα * κιβώτια». Όταν το συγκεκριμένο τμήμα ολοκληρώσει τις καταχωρήσεις του και έχει στείλει τις παραγγελίες στους προμηθευτές, πρέπει να στείλει το αρχείο στη μητρική εταιρεία, αλλά για κάποιο λόγο τους ενοχλούν οι εν λόγω καταχωρίσεις και καθόντουσαν να εντοπίσουν τα κελιά ένα-ένα και να αντικαταστήσουν με την τελική ποσότητα. Δεν μπορείς να φανταστείς τι κόπο γλυτώνουν. Εν προκειμένω τη ρουτίνα την καλούν κατά περίπτωση πριν την αποστολή του αρχείου. Σκέφτηκα αφού δεν μπορούμε να την ενσωματώσουμε μέσα στο ίδιο το αρχείο, δεν μένει άλλος τρόπος παρά να ανοίγουν και αυτό το .xlsm σαν βοηθητικό αρχείο και να υποδεικνύουν την περιοχή (ολόκληρη στήλη ή στήλες) όπου πρέπει να γίνει η αντικατάσταση. Εγώ στο σπίτι με Office 13 μπορώ στο InputBox να υποδείξω περιοχή από άλλο ανοικτό αρχείο. Στη δουλειά όμως με Office 7 δεν λειτούργησε. Κάπου διάβασα για συνδυασμό πλήκρων ctr + tab, αλλά και πάλι δεν έπαιξε. Έτσι σε ένα οποιοδήποτε κελί μετά το «=» υπέδειξα την στήλη με αποτέλεσμα να πάρω στο κελί τη διαδρομή και με αντιγραφή επικόλληση στο InputBox να λειτουργήσει. Φαντάζομαι δεν υπάρχει άλλος τρόπος. Αλλά κι έτσι μικρός ο κόπος για το τεράστιο όφελος.
Τέλος έκανα κάποιες προσθήκες στον κώδικα για να μη βγάζει σφάλμα εάν πατήσει ο χρήστης άκυρο καθώς και να αγνοεί τα κλειδωμένα κελιά. Δεν ξέρω εάν συμφωνείς με τον τρόπο που τα έγραψα.
Φιλικά
Δημήτρης

[kapetang]

Καλησπέρα

Δημήτρη χαίρομαι που μπόρεσα να βοηθήσω.

1) Με τις προσθήκες σου συμφωνώ.

Μια συντόμευση στον κώδικα θα μπορούσε να είναι η παρακάτω.

Sub ReplaceMultiRecursive()
'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion
'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά
'στα οποία θέλουμε να γίνουν αλλαγές
'-----------------------------------------------------------------------------------
    Dim i As Long, j As Long
    Dim rngSource As Range, rngTarget As Range

    On Error GoTo Error_Handel

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)
    Set rngTarget = Application.InputBox("Επιλογή πάνω αριστερού κελιού περιοχής υποδοχής", , , , , , , 8)

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .ShowWindowsInTaskbar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    For i = 1 To rngSource.Rows.Count
        For j = 1 To rngSource.Columns.Count

            If rngSource.Cells(i, j).Locked = False And InStr(rngSource.Cells(i, j).Formula, "-") = 0 _
                    And InStr(rngSource.Cells(i, j).Formula, "/") = 0 Then

                If rngSource.Cells(i, j).HasFormula Then
                    'Η Public μεταβλητή έχει δηλωθεί στο Module2. Εδώ αρχικοποιείται
                    strF = rngSource.Cells(i, j).Formula
                    rngTarget.Cells(i, j).Formula = ReplaceMultiRecursion(rngSource.Cells(i, j).Formula)
                Else
                    rngTarget.Cells(i, j) = rngSource.Cells(i, j)
                End If

            Else
            End If


        Next
    Next
    MsgBox "Ολοκληρώθηκε!"
Sub_Exit:

    With Application
        .Calculation = xlCalculationAutomatic
        .ShowWindowsInTaskbar = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub

Error_Handel:
    MsgBox "Πιθανόν δεν δόθηκε σωστά η περιοχή δεδομένων ή η περιοχή αντιγραφής των αποτελεσμάτων", vbCritical + vbOKOnly, "Λάθος!"
    Resume Sub_Exit
End Sub

2) Αν το αρχείο φορτωνόταν ως Add-ins ίσως να λειτουργούσε και στο office 2007

Φιλικά/Γιώργος

[jockey17]

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

[kapetang]

Καλησπέρα

Δημήτρη είδα καλύτερα τον κώδικα που πρόσθεσες.

Αν κατάλαβα καλά θέλεις μια περιοχή να αντιγράφεται σε μια άλλη ως εξής:

Αν ένα κελί είναι προστατευμένο ή έχει τύπο που περιέχει το «-» ή το «/» αντιγράφεται όπως είναι, διαφορετικά καλείται η συνάρτηση για να κάνει την κατάλληλη αλλαγή.

Για την υλοποίηση της παραπάνω λογικής ο κώδικας θα πρέπει να έχει τη μορφή:

Sub ReplaceMultiRecursive()
'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion
'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά
'στα οποία θέλουμε να γίνουν αλλαγές
'-----------------------------------------------------------------------------------
    Dim i As Long, j As Long
    Dim rngSource As Range, rngTarget As Range

    On Error GoTo Error_Handel

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)
    Set rngTarget = Application.InputBox("Επιλογή πάνω αριστερού κελιού περιοχής υποδοχής", , , , , , , 8)

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .ShowWindowsInTaskbar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    For i = 1 To rngSource.Rows.Count
        For j = 1 To rngSource.Columns.Count

            If rngSource.Cells(i, j).Locked = False And _
               InStr(rngSource.Cells(i, j).Formula, "-") = 0 And _
               InStr(rngSource.Cells(i, j).Formula, "/") = 0 And _
               rngSource.Cells(i, j).HasFormula Then
                'Η Public μεταβλητή έχει δηλωθεί στο Module2. Εδώ αρχικοποιείται
                strF = rngSource.Cells(i, j).Formula
                rngTarget.Cells(i, j).Formula = ReplaceMultiRecursion(rngSource.Cells(i, j).Formula)
            Else
                rngTarget.Cells(i, j) = rngSource.Cells(i, j)
            End If
        Next
    Next
    MsgBox "Ολοκληρώθηκε!"
Sub_Exit:

    With Application
        .Calculation = xlCalculationAutomatic
        .ShowWindowsInTaskbar = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub

Error_Handel:
    MsgBox "Πιθανόν δεν δόθηκε σωστά η περιοχή δεδομένων ή η περιοχή αντιγραφής των αποτελεσμάτων", vbCritical + vbOKOnly, "Λάθος!"
    Resume Sub_Exit
End Sub

Φιλικά/Γιώργος