macro per sostituzione parola su n file

[luca62]

Necessito, a meno di fare un lavoro mostruoso...di sostituire a 1000 file inclusi in una cartella
le seguenti parole al posto di altre es:
dove trovo XXXXXXXX ISO 4017 8.8 con XXXXXXXX TE UNI 5739
dove trovo XXXXXXXX ISO 4762 8.8 con XXXXXXXX TCCE UNI 5931

dove xxxxxx sono una serie di caratteri

ETC ETC.
I 1000 files sono files chiusi contenuti in una cartella
è possibile creare una macro ?
o chiedo la Luna?

[Flash30005]

Dici

dove xxxxxx sono una serie di caratteri

ma sono sempre uguali questa serie di caratteri ?
intendo la prima stringa è sempre uguale diversa dalla seconda ma anche la seconda sempre uguale?

Sarebbe opportuno che inviassi un file esempio

ciao

[Anthony47]

Sarebbe opportuno che inviassi un file esempio

da cui dedurre, per cominciare,di che tipo di file si tratta.

Ciao

[luca62]

hai ragione, : ad esempio

VITE M10X110 ISO 4017 8.8 DEVO CAMBIARE IN VITE M10X110 TE UNI 5739

VITE M12X75 ISO 4017 8.8 DEVO CAMBIARE IN VITE M12X75 TE UNI 5739

VITE M4X12 UNI 5933 DEVO CAMBIARE IN VITE M4X12 TPSCE 10.9

VITE M4X16 ISO 4762 8.8 DEVO CAMBIARE IN VITE M4X16 TCCE 10.9 UNI 5931


E COSì VIA.
L'IDEALE SAREBBE POTER SCRIVER COS':
DOVE SONO PRESENTI:

ISO 4017 8.8 CAMBIA TE UNI 5739
UNI 5933 DEVO CAMBIARE IN TPSCE 10.9
ISO 4762 8.8 DEVO CAMBIARE IN TCCE 10.9 UNI 5931

E COSì TANTE ALTRE , MANTENENDO QUINDI LA PRIMA PARTE UGUALE :
VITE M12X110
VITE M12X75
VITE M4X12
VITE M4X16
SPERO ORA DI ESSERE STATO CHIARO
CIAO

[luca62]

allego file esempio con in giallo le righe da cambiare
https://www.dropbox.com/s/5clnx5jnceugc ... o.xls?dl=0

[Anthony47]

Oh, cosi' sappiamo che si tratta di file Excel...

Ecco un esempio di file con macro utilizzabile per questa operazione:
https://www.dropbox.com/s/8bnjzkdbweih5 ... .xlsm?dl=0
La macro da lanciare e' la Sub MassMod, dopo aver compilato, all'interno del codice macro, le righe marcate <<< secondo la tua situazione.
In Foglio1 del file dovrebbe crearsi un riepilogo di quali file sono stati esaminati e quante celle sono state modificate.
Mi raccomando di eseguire un backup totale dei file che saranno lavorati PRIMA dell'esecuzione della macro, perche' non garantisco che al completamento della macro i file siano secondo le tue aspettative.
Ovviamente ti suggerisco di collaudare il tutto con pochi file di prova e di verificare se la situazione prima e dopo sono pari a quello che ti aspetti.

Ciao

[luca62]

TUTTO OK GRAZIE!

[luca62]

ero stato troppo ottimista, o meglio la macro va da Dio ma mi crea dei problemi di loop,dovrei cercare di " dire:

elemento da sostituire : UNI 5739-8G con UNI 5739-8G TE ,ma solo se TE non è già presente nella stringa completa
la stringa completa ad esempio è VITE M5X16 UNI 5739-8G , ma mi può capitare anche VITE M5x16 UNI 5739-8G TE
ossia già corretta , che non voglio cambiare,come mi può capitare di fare questa operazione
sostituire VITE TCCE M8X55 UNI 5931 con VITE TCCE M8X55 UNI 5931 8G ma solo dove 8G non sia già presente.
Il tutto considerando che M8x5e può essre M12x 85 etc etc.
come posso fare?

[Anthony47]

La macro si occupa di sostituire le stringhe che gli dichiari, tralasciando altro testo all'interno delle celle.

Ho cercato di mappare nel codice macro l'esigenza che hai descritto; il nuovo codice:

Codice: Seleziona tutto

Sub MassMod()
Dim myOrigin, myRep, myPath As String, C As Range
Dim I As Long, J As Long, myCnt() As Long, myFile As String
'
myPath = "D:\PIPPO\4LUCA"                           '<<< La directory dove si trovano i file da lavorare
myOrigin = Array("ISO 4017 8.8", "ISO 4762 8.8")    '<<< I Termini da cercare
myRep = Array("TE UNI 5739", "TCCE UNI 5931")       '<<< I Termini sostitutivi
'
ReDim myCnt(LBound(myOrigin, 1) To UBound(myOrigin, 1))
'
myFile = Dir(myPath & "\*.xls*")
Do Until myFile = ""
    Erase myCnt
    ReDim myCnt(LBound(myOrigin, 1) To UBound(myOrigin, 1))
'
    Workbooks.Open (myPath & "\" & myFile)
    For I = 1 To ActiveWorkbook.Worksheets.Count
        Worksheets(I).Select
        With ActiveSheet.UsedRange
            For J = LBound(myOrigin, 1) To UBound(myOrigin, 1)
                Set C = .Find(myOrigin(J), LookIn:=xlValues, lookat:=xlPart)
                If Not C Is Nothing Then
                    firstAddress = C.Address
                    Do
                        If InStr(1, C.Value, myRep(J), vbTextCompare) = 0 Then
                            myCnt(J) = myCnt(J) + 1
                            C.Value = Replace(C.Value, myOrigin(J), myRep(J), , , vbTextCompare)
                        End If
                        Set C = .FindNext(C)
                    Loop While Not C Is Nothing 'And C.Address <> firstAddress
                End If
            Next J
        End With
    Next I
    ActiveWorkbook.Close True
    With ThisWorkbook.Sheets("Foglio1")
        mynext = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(mynext, 1) = myFile
        .Cells(mynext, 2) = myCnt(LBound(myCnt, 1))
        .Cells(mynext, 3) = myCnt(LBound(myCnt, 1) + 1)
    End With
myFile = Dir
Loop
MsgBox ("Completato...")
End Sub


Il file pubblicato su dropbox e' aggiornato a questo livello.

Ciao

[luca62]

mi si pianta di brutto

esempio questo file
https://www.dropbox.com/s/mgrjjmjdb7obrku/4009.xls?dl=0

e ti allego il file dove ho copiato la tua ultima macro
sostituendo la directory e quello che necessito di sostituire

https://www.dropbox.com/s/xm4cfk5nqfnbd ... .xlsm?dl=0
non capisco perchè si blocchi

[Anthony47]

Ek gia'... Se la stringa sostitutiva include la stringa sostituita la vecchia macro va in loop.
Ho modificato la macro contenuta nel file pubblicato su Dropbox per eliminare questa situazione, e ho anche modificato la parte di riepilogo, inserendo tutte le intestazioni cosi' che sono presenti nella variabile myRep (cioe' le voci sostitutive).

Ciao