Εμφάνιση ενός μόνο μηνύματος
  #8  
Παλιά 23-07-14, 14:41
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.737
Προεπιλογή

Καλησπέρα

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

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

Φιλικά/Γιώργος
Απάντηση με παράθεση