Forum - VBA Αντικατάσταση πολλαπλασιασμού σε τύπο με την τιμή του γινόμενου

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Αντικατάσταση πολλαπλασιασμού σε τύπο με την τιμή του γινόμενου (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3245-antikatastasi-pollaplasiasmoi-se-tipo-me-tin-timi-toy-ginomenoy.html)

Στον προηγούμενο κώδικα η γραμμή:

rngTarget.Cells(i, j) = rngSource.Cells(i, j)

να αντικατασταθεί με την:

rngTarget.Cells(i, j).Formula = rngSource.Cells(i, j).Formula

Γεια σου Γιώργο.
Δεν είναι ακριβώς έτσι, ότι μία περιοχή αντιγράφεται σε μία άλλη, αλλά αντιγράφεται στον εαυτό της – αντικαθιστά κατά την αντιγραφή στον εαυτό της τον πολλαπλασιασμό και όλα τα άλλα τα αφήνει ανέπαφα.
Έτσι χρησιμοποιώντας τον τροποποιημένο κώδικα, όταν το εκτελώ στο αρχείο το οποίο εντέλει θα σταλεί και στη μητρική εταιρία, επειδή αυτό είναι κλειδωμένο με ξεκλείδωτα μόνο τα κελιά όπου καταχωρούνται οι παραγγελίες ( ποσότητα * κιβώτια ), τελικά βγαίνει σφάλμα όταν προσπαθεί να αντιγράψει τους υπόλοιπους τύπους αυτούσια όπως είναι, αλλά σε κλειδωμένο κελί. Πράγματι θα χρειαζόταν η νέα τροποποίηση εάν η περιοχή επικόλλησης γινόταν σε άλλο φύλλο ξεκλείδωτο, όπου χωρίς αυτή την τροποποίηση δεν θα έφερνε όλους τους τύπους που θα εντόπιζε σε κλειδωμένα κελιά. Έτσι για να δουλέψει πρέπει να αγνοεί εντελώς τα κλειδωμένα κελιά, διαφορετικά δεν μπορεί να εκτελεστεί η ρουτίνα.
Σχετικά με τη διόρθωση:
rngTarget.Cells(i, j) = rngSource.Cells(i, j)
σε
rngTarget.Cells(i, j).Formula = rngSource.Cells(i, j).Formula
φαντάζομαι πως ναι είναι απαραίτητη, αν και η πρώτη διατύπωση (χωρίς το . Formula) έχει ως αποτέλεσμα να μην πειράζει καθόλου το κελί που δεν έχει συνάρτηση, τότε μάλλον και αυτό δεν πειράζει. Για την ορθότητα όμως θα το διορθώσω.
Παρεμπιπτόντως με το AddIn έπαιξε άψογα.
Φιλικά
Δημήτρης

Καλησπέρα

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

Κώδικας:

Sub ReplaceMultiRecursive()

'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion

'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά

'στα οποία θέλουμε να γίνουν αλλαγές

'-----------------------------------------------------------------------------------

    Dim i As Long, j As Long

    Dim rngSource As Range
 

    On Error GoTo Error_Handel
 

    Set rngSource = 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

                rngSource.Cells(i, j).Formula = ReplaceMultiRecursion(rngSource.Cells(i, j).Formula)

            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

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

Ή καλύτερα με τον παρακάτω:

Κώδικας:

Sub ReplaceMultiRecursive()

'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion

'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά

'στα οποία θέλουμε να γίνουν αλλαγές

'-----------------------------------------------------------------------------------

    Dim c As Range

    Dim rngSource As Range
 

    On Error GoTo Error_Handel
 

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)
 

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        .ShowWindowsInTaskbar = False

        .EnableEvents = False

        .DisplayAlerts = False

    End With
 

    For Each c In rngSource

        If c.Locked = False And _

           InStr(c.Formula, "-") = 0 And _

           InStr(c.Formula, "/") = 0 And _

           c.HasFormula Then

            'Η Public μεταβλητή έχει δηλωθεί στο Module2. Εδώ αρχικοποιείται

            strF = c.Formula

            c.Formula = ReplaceMultiRecursion(c.Formula)

        End If

    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

Πράγματι η τελευταία απλοποίηση στον κώδικα είναι περιεκτική και ολοκληρωμένη για το συγκεκριμένο στόχο που πρέπει να επιτευχθεί, και ευθύς αμέσως την τοποθέτησα στο AddIn.
Μέσα από όλη τη διαδικασία των τροποποιήσεων κράτησα σαφώς κι εκείνη – την πιο ολοκληρωμένη – σε περίπτωση που η περιοχή επικόλλησης είναι διαφορετική από την περιοχή αντιγραφής και πρέπει να μην αγνοείται κανένα κελί, έτσι ώστε εάν προκύψει ανάγκη στο μέλλον για ίδια ή παρόμοια ενέργεια να έχω κάτι πάνω στο οποίο μπορώ να «πατήσω».
Να είσαι καλά Γιώργο, να μας δίνεις τα φώτα σου.
Ευχαριστώ
Δημήτρης

Δημήτρη να είσαι επίσης καλά.