You are here:Home-Domande su Excel VBA e MACRO-Trova sostituisci con macro-Rispondi a: Trova sostituisci con macro
Rispondi a: Trova sostituisci con macro2020-07-20T13:55:07+02:00

Home Forum Domande su Excel VBA e MACRO Trova sostituisci con macro Rispondi a: Trova sostituisci con macro

sidsid
Moderatore
    Post totali: 752

    Ciao

    Prova questa modifica:

    Sub New_categoria()
    'macro revisionata da Sid 13 luglio 2014 Archi.forumup
    Dim xlCal As XlCalculation
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCal = .Calculation
        .Calculation = xlCalculationManual
    End With
    Dim sh As Worksheet
    Dim area As Range
    Dim iRiga As Long
    Dim trv As Variant
    Dim sst() As Variant
    Dim Indice As Integer
    Dim cl As Range
    Dim t As Date
    Dim RISP As Integer
    t = Time
    
    Set sh = ActiveSheet
    'Set sh = Sheets("__Tesserati__")
    sh.Unprotect
    
    With sh
        Set area = .Range("E3:E" & .Range("E" & Rows.Count).End(xlUp).Row)
        Dim i As Integer
        For i = 1 To 20
           trv = trv & CAT_NUOVO_ANNO.Controls("Textbox" & i) & ";"
        Next i
        
        trv = Mid(trv, 1, Len(trv) - 1)
        'trova
        trv = Split(trv, ";")
        
        'sostituisci
        For i = 1 To 20
            ReDim Preserve sst(i - 1)
            sst(i - 1) = CAT_NUOVO_ANNO.Controls("Combobox" & i)
        Next i
        
        For Each cl In area
            For Indice = LBound(trv) To UBound(trv)
                If .Range("E" & cl.Row).Value = trv(Indice) And sst(Indice) <> vbNullString Then
                    .Range("E" & cl.Row).Value = sst(Indice)
                    Exit For
                End If
            Next Indice
        Next cl
    End With
    Exit Sub
    Sheets("__Tesserati__").Protect
    Set area = Nothing
    Set sh = Nothing
    '
    With Application
        .Calculation = xlCal
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    End Sub