ITLearning/Dr.Excel

Scris: **Mie Oct 07, 2009 1:58 pm**

se pot face niste macro astfel incat sa execute find and replace, am diferite documente unde terbuie sa scot diacritice si stau de fiecare data cu find and replace si e cam obositor...

Later edit: am gasit nu reuseam sa fac pt ca in momentul cand inregistram incercam sa selectez cu mouseul nu din tastatura ca sa dau find and replace, se poate sterge cred...

Scris: **Mie Oct 07, 2009 2:14 pm**

Daca tot ai deschis subiectul, hai sa bagam si un macro.
Eu scriu mereu cu diacritice, si mai ales cand nu trebuie

.

Asa ca am inregistrat un macro care sa faca aceste inlocuiri:

Cod: Selectaţi tot

Sub InlocuireDiacritice()
On Error GoTo err
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "î"
        .Replacement.Text = "i"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "?"
        .Replacement.Text = "a"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "â"
        .Replacement.Text = "a"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "?"
        .Replacement.Text = "t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "?"
        .Replacement.Text = "s"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Exit Sub

err:
    MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"
End Sub

Scris: **Mie Oct 07, 2009 2:18 pm**

Din pacate nu pot scrie cu diacritice, asa ca am exportat modulul *.bas.

Scris: **Mie Oct 07, 2009 2:38 pm**

chiar ma intrebam de ce ai vrea sa ilocuiesti semnul intrebarii

) ms am reusit si eu sa fac si e cam aceeasi chestie.

Scris: **Mie Oct 07, 2009 3:03 pm**

Si ca sa mai "complic" situatia... ma bag si eu...

Cod: Selectaţi tot

Sub InlocuireCaractere()
    srcString = "S,s,T,t,A,a,I,i,A,a"
    dstString = "Ş,ş,Ţ,ţ,Ă,ă,Î,î,Â,â"
    
    srcArray = Split(srcString, ",")
    dstArray = Split(dstString, ",")
    
    For i = 0 To UBound(srcArray)
        Call ReplaceCHR(srcArray(i), dstArray(i))
    Next i
    
End Sub

Sub ReplaceCHR(ByVal srcCHR As String, ByVal dstCHR As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = srcCHR
        .Replacement.Text = dstCHR
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Unde "functia principala" este InlocuireCaractere() si tot ce mai ramane de configurat sirul sursa srcString si cel corespunzator "destinatie" - dstString, in exemplul meu ambele sunt identice pentru ca din aceleasi motive ca si Alexx nu putem folosi diacritice pe acest forum...

Si daca vrei sa faceti vreo sicana unui coleg... puteti face o combinatie de "sursa" = a,b,c,d,e,f,g cu o "destinatie"=1,2,3,4,5,6,7

ATENTIE la corespondenta dintre cele 2 siruri, trebuie sa fie intotdeauna egale si aveti grija ce litere inlocuiti...

Scris: **Mie Oct 07, 2009 3:18 pm**

Bun asa Lucian.
Mi-am actualizat si eu codul

Scris: **Mie Oct 07, 2009 4:54 pm**

mult mai elegant ce a scris lucian

foarte frumos mersi

Scris: **Mar Oct 13, 2009 11:13 am**

jeleu scrie:mult mai elegant ce a scris lucian foarte frumos mersi

Cu placere... si in cazul in care te intereseaza si ceva pentru Excel vezi mesajul de pe DrExcel - VBA pentru eliminare diacritice (si alte caractere) mai ales ca este un macro "generic" care va functiona si pe Word si pe Excel...

Pentru cei care nu au cont si pe DrExcel (ar fi bine sa va faceti...

) dar aveti si codul pus mai jos:

Cod: Selectaţi tot

Sub InlocuireCaractere()
    srcString = "S,s,T,t,A,a,I,i,A,a"
    dstString = "S,s,T,t,A,a,I,i,A,a"
    
    srcArray = Split(srcString, ",")
    dstArray = Split(dstString, ",")
    
    If Application.Name Like "*Excel*" Then
        lcAppType = "XLS"
    Else
        If Application.Name Like "*Word*" Then
            lcAppType = "DOC"
        Else
            MsgBox ("Tip aplicatie necunoscut!")
            Return
        End If
    End If
    
    For i = 0 To UBound(srcArray)
        If lcAppType = "XLS" Then
            Call ReplaceCHRXLS(srcArray(i), dstArray(i))
        Else
            If lcAppType = "DOC" Then
                Call ReplaceCHRDOC(srcArray(i), dstArray(i))
            End If
        End If
    Next i
    
End Sub

Sub ReplaceCHRDOC(ByVal srcCHR As String, ByVal dstCHR As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = srcCHR
        .Replacement.Text = dstCHR
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Sub ReplaceCHRXLS(ByVal srcCHR As String, ByVal dstCHR As String)
        Selection.Replace What:=srcCHR, Replacement:=dstCHR, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Scris: **Mar Oct 12, 2010 9:26 pm**

Putem folosi cuvinte in loc de litere?
srcString = "S,s,T,t,A,a,I,i,A,a"
dstString = "Ş,ş,Ţ,ţ,Ă,ă,Î,î,Â,â"

srcString = "Sus,mijloc,patrat"
dstString = "Jos,margine,rotund"
????

Scris: **Mar Oct 12, 2010 9:28 pm**

Dap, poti folosi si cuvinte, dar sa ai grija la ordinea in care le pui si la cautare si la inlocuire. Asa ca in exemplul tau:
mare sa coresp. cu mic, mediu cu mare, etc.

ITLearning/Dr.Excel

Macro pentru inlocuire diacritice

Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice

Re: Macro pentru inlocuire diacritice