Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 25-01-17, 14:56
Το avatar του χρήστη Spirosgr
Spirosgr Ο χρήστης Spirosgr δεν είναι συνδεδεμένος
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.321
Προεπιλογή

Κώδικας:
Option Explicit
'Στο Array iFind, βάζουμε, ό,τι θέλουμε να αλλάξουμε.
'Στο Array iReplace, βάζουμε, αυτό με το οποίο θέλουμε να το αλλάξουμε.
'Δεκτό: συνδιασμοί χαρακτήρων πχ: Φ με Fi, τρ με TR
'Δεκτό: αριθμοί
'Δεκτό: multi language

'MatchCase:=True (διακρίνει κεφαλαία - πεζά)
'Αν MatchCase:=False (δεν διακρίνει κεφαλαία - πεζά)

'Τα δύο Array πρέπει να έχουν τις αντίστοιχες τιμές για αντικατάσταση πχ:
'Στην 2η θέση του iFind = "Ω"
'Στην 2η θέση του iReplace = "O"
'Σημαίνει αντικαθιστώ Ω με O

'ΣΗΜΕΙΩΣΗ:

'Στην έκφραση: Sh1.Cells(i, 1)
'Όπου Sh1. = Το κωδικό όνομα φύλλου
'Όπου 1 = Η στήλη φύλλου (1=a , 4=d κλπ)
'Αν το Option Explicit υπάρχει ήδη στον VBA editor, το παραβλέπουμε

Sub Multiple_Search_And_Replace()

    Dim iFind As Variant, iReplace As Variant
    Dim x As Long, i As Long, Lrow As Long

    iFind = Array("Σ", "Ω", "Γ", "Δ", "Φ", "Π", "ρ", "σ", "ξ", "ω", "22")

    iReplace = Array("S", "O", "G", "D", "Fi", "P", "r", "s", "ks", "o", "55")

    Lrow = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To Lrow

        For x = LBound(iFind) To UBound(iFind)

            Sh1.Cells(i, 1).Replace What:=iFind(x), Replacement:=iReplace(x), _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
                                    SearchFormat:=False, ReplaceFormat:=False

        Next x

    Next i

End Sub 
Απάντηση με παράθεση