You are here:Home-Domande su Excel VBA e MACRO-[RISOLTO] Sostituzione dato su più fogli e relativo salvataggio-Rispondi a: [RISOLTO] Sostituzione dato su più fogli e relativo salvataggio
Rispondi a: [RISOLTO] Sostituzione dato su più fogli e relativo salvataggio2018-01-16T14:39:48+01:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Sostituzione dato su più fogli e relativo salvataggio Rispondi a: [RISOLTO] Sostituzione dato su più fogli e relativo salvataggio

sidsid
Moderatore
    Post totali: 752

    Ciao
    Ti passo anche la subroutine che sfrutta le matrici; con soli 3 fogli sembra più veloce il codice che sfrutta il metodo Find; ma bisogna testarli entrambi su centinaia di fogli per capire quale è il più performante.

    Sub SOSTITUISCI_CERTIFICATI_BY_MATRIX(ByVal sCertificato1 As String, ByVal sCertificato2 As String, ByRef s As String)
    Dim wbNuovo As Workbook
    Dim ws As Worksheet
    Dim nRiga As Long, nLoop1 As Long, nLoop2 As Long
    Dim Area As Range
    Dim bEsiste As Boolean
    Dim sDir As String
    Dim vTabella As Variant
    
    Application.ScreenUpdating = False
    
    'verifico l'esistenza della cartella principale (NOMINATIVI); nel caso la creo
    sDir = "C:\NOMINATIVI\"
    If Dir(sDir, vbDirectory) = "" Then
        MkDir (sDir)
    End If
    'ciclo tutti i fogli
    For Each ws In ThisWorkbook.Worksheets
        bEsiste = False
        
        'verifico l'esistenza della cartella foglio (es. ANNA); nel caso la creo
        sDir = "C:\NOMINATIVI\" & ws.Name & "\"
        If Dir(sDir, vbDirectory) = "" Then
            MkDir (sDir)
        End If
    
        nRiga = ws.Range("A" & Rows.Count).End(xlUp).Row
        Set Area = ws.Range("A7:J" & nRiga)
        vTabella = Area.Value
        
        For nLoop1 = LBound(vTabella, 1) To UBound(vTabella, 1)
            For nLoop2 = LBound(vTabella, 2) To UBound(vTabella, 2)
                If StrComp(vTabella(nLoop1, nLoop2), sCertificato1, vbTextCompare) = 0 Then
                    bEsiste = True
                    vTabella(nLoop1, nLoop2) = sCertificato2
                End If
            Next nLoop2
        Next nLoop1
        
        Area = vTabella
        If bEsiste Then
            s = s & ws.Name & vbLf
            ws.Copy
            Set wbNuovo = ActiveWorkbook
            Application.DisplayAlerts = False
            wbNuovo.SaveAs sDir & "INDEX", FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            wbNuovo.Close True
            
        End If
    Next ws
    Application.ScreenUpdating = True
    Set Area = Nothing
    End Sub

    Ti passo anche la modifica al codice del pulsante, in cui ho inserito la verifica del tempo impiegato.
    Aggiungi ad inizio codice queste 2 istruzioni

    Dim t As Date
    t = Time

    Poi sostituisci il messaggio con

    MsgBox "Ho Aggiornato i seguenti fogli:" & vbLf & sFogli & _
    vbLf & "CODICE ESEGUITO IN....." & Format(Time - t, "HH:MM:SS"), vbInformation, "AGGIORNAMENTO FOGLI"

    Spero sia tutto chiaro; ciao.