Trova e sostituisci in tutti i fogli di più files in una cartella

Stato
Chiusa ad ulteriori risposte.

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.697
1.733
Como
2011MAC 2016WIN
514
Ciao ha tutti,
condivido un'applicazione che cerca in tutti i fogli di più files contenuti in una cartella indicata in un percorso.

Codice:
Option Explicit
Sub Sostituisci_testo()
    'by Ges - ForumExcel.it
    Dim myArray() As Variant
    Dim i As Long
    Dim iText As Integer
    Dim x As Integer
    Dim uRow As Integer
    Dim uR As Long
    Dim uCol As Long
    Dim sPath As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim OldText As String
    Dim NewText As String
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With
    On Error GoTo esci
    uR = Sheets("Foglio1").Cells(Rows.Count, 1).End(xlUp).Row
    For iText = 2 To uR
        OldText = ThisWorkbook.Sheets("Foglio1").Cells(iText, 1)
        NewText = ThisWorkbook.Sheets("Foglio1").Cells(iText, 2)
        sPath = UserForm1.TextBox3.Text
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(sPath)
        For Each objFile In objFolder.Files
            Select Case LCase(Right(objFile.Name, 4))
                Case ".xls", "xlsx", "xlsm"
                    Set wk = Workbooks.Open(objFile.Path)
                    For Each sh In wk.Worksheets
                        On Error Resume Next
                        sh.Activate
                        With ActiveSheet.UsedRange
                            uRow = .Rows.Count + .Row - 1
                            uCol = .Columns.Count + .Column - 1
                        End With
                        myArray = Range(Cells(1, 1), Cells(uRow, uCol))
                        For i = 1 To uRow
                            For x = 1 To uCol
                                myArray(i, x) = Replace(myArray(i, x), OldText, NewText)
                            Next x
                        Next i
                        Range(Cells(1, 1), Cells(uRow, uCol)) = myArray
                    Next
            End Select
        Next objFile
        ActiveWorkbook.Close SaveChanges:=True
    Next iText
    MsgBox "Operazione completata!", vbInformation, "NOTIFICA"
    GoTo uscita
esci:
    MsgBox "Verifica la correttezza del percorso che hai inserito!", vbInformation, "NOTIFICA"
uscita:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .AskToUpdateLinks = True
    End With
End Sub
 

Allegati

Ultima modifica:

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
5.239
213
43
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
376
Ciao ges, ottimo contributo. Non ho dubbi sul corretto funzionamento, vorrei però fare un'osservazione: se ben capisco, per ogni coppia di trova/sostituisci la routine apre, sostituisce e chiude tutti i file della cartella... Credo che sarebbe molto più efficiente invertire i cicli: per ogni file, apri, fai tutte le sostituzioni, salva e chiudi. Così ogni file si apre una volta sola, non credi? Ciao SmileForum
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.697
1.733
Como
2011MAC 2016WIN
514
Ciao Enrico,
salvo che mi stia sfuggendo qualcosa, in realtà la sub apre i file contenuti nella cartella uno a uno, di ciascun file scorre tutti i fogli, trova e sostituisce, poi chiude il file e ne apre un secondo, scorre anche qui tutti i fogli, trova e sostituisce, quindi lo chiude e passa al file successivo .. ecc. ecc. finchè scorre tutti i files.
 
G

gibra

Guest
I file vengono aperti e chiusi all'interno del ciclo For/Next

Codice:
For iText = 2 To uR
quindi mi pare che Enrico abbia ragione.

Inoltre, le celle non vengono tutte modificate come ci si aspetta.
Con il file che ti allego, solo il primo valore è stato modificato da blu a bianco.
 

Allegati

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
5.239
213
43
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
376
Io non ho ancora capito quando sia del tutto indispensabile e quando si possa omettere, comunque ormai nel dubbio (e dopo diverse testate sul muro) scrivo sempre

Codice:
[COLOR=#ff0000][B]sh.[/B][/COLOR]Range([COLOR=#ff0000][B]sh.[/B][/COLOR]Cells(1, 1), [COLOR=#ff0000][B]sh.[/B][/COLOR]Cells(uRow, uCol)) = myArray
A meno che non mi trovi all'interno di un blocco With, ovviamente
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.697
1.733
Como
2011MAC 2016WIN
514
Io non ho ancora capito quando sia del tutto indispensabile e quando si possa omettere, comunque ormai nel dubbio (e dopo diverse testate sul muro) scrivo sempre

Codice:
[COLOR=#ff0000][B]sh.[/B][/COLOR]Range([COLOR=#ff0000][B]sh.[/B][/COLOR]Cells(1, 1), [COLOR=#ff0000][B]sh.[/B][/COLOR]Cells(uRow, uCol)) = myArray
A meno che non mi trovi all'interno di un blocco With, ovviamente
Ciao Enrico,
si può omettere perché qui ho usato

Codice:
sh.Activate
e come ben sai le istruzioni senza indicazioni del foglio di riferimento operano nel foglio attivo.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.697
1.733
Como
2011MAC 2016WIN
514
I file vengono aperti e chiusi all'interno del ciclo For/Next

Codice:
For iText = 2 To uR
quindi mi pare che Enrico abbia ragione.

Inoltre, le celle non vengono tutte modificate come ci si aspetta.
Con il file che ti allego, solo il primo valore è stato modificato da blu a bianco.
Hai ragione Gibra,
mi chiedo se il problema che nel tuo esempio ha modificato solo le prime celle nel tuo esempio potrebbe essere dovuto a

Codice:
uRow = ActiveSheet.UsedRange.Row
uCol = ActiveSheet.UsedRange.Column
Anche se è strano, dovrebbe trovarmi l'ultima riga e l'ultima colonna usata.
 

dracoscrigno

CioccaPiatti & VBA Expert
Expert
1 Maggio 2016
4.023
63
office pro 2010
58
ActiveSheet.UsedRange.Row (.Column) individua la prima riga/colonna del range, non l'ultima. Per l'ultima bisogna usare .Rows.Count (o, più correttamente, .Rows.Count + .Row -1)

Codice:
[COLOR=#800080]ActiveSheet[/COLOR].[COLOR=#0000FF]UsedRange[/COLOR].[COLOR=#FF0000]Row[/COLOR] (.Column)
LA riga del range utilizzato del foglio attivo

tra tutte le possibili righe quale?

la riga di numero pari al numero di [SUB][SUP](punto)[/SUP][/SUB]Column

quanto vale .Column?

Bisogna andare a vedere a cosa si riferisce quel punto.... Non è detto ne che sia la prima riga ne che sia l' ultima

e, comunque, c'è un errore... manca la "s" : ActiveSheet.UsedRange.Rows
 

klingklang

Ciappinaro VBA_Expert
Expert
20 Ottobre 2017
5.239
213
43
San Giovanni in Persiceto (BO)
www.excelswissknife.com
2016, 365
376
No draco, stavolta ti sbagli. Se metti la "s" allora ti riferisci alla Collection e devi indicarne l'indice (.Rows(1), .Rows.Count). Senza la"s" indichi la riga del range, che come risultato dà l'indice di riga più basso di tutto il range

Edit: scusa ho capito adesso, ti ho messo fuori strada con il (.Column). Non voleva essere un'istruzione unica, voleva significare UsedRange.Row oppure UsedRange.Column.
Sto scrivendo da smartphone e volevo economizzare, ma ho creato un equivoco, hai ragione
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
22.697
1.733
Como
2011MAC 2016WIN
514
Effettivamente ho sbagliato io, come dice Enrico dovevo contare anche le righe e le colonne

Codice:
ActiveSheet.UsedRange.Rows.Count + .Row - 1
ActiveSheet.UsedRange..Columns.Count + .Column - 1

Correggo la macro sopra.
 

Allegati

Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!