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

[kapetang]

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

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

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

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

[jockey17]

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

[kapetang]

Καλησπέρα

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

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

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

[kapetang]

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

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

[jockey17]

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

[kapetang]

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