Macro trova e sostituisci

Question

Ho un foglio Excel che è composto da n righe ed m colonne la prima colonna contiene un numero o una data (meglio la data) a partire , per esempio, dal 01/01/2017. Nelle restanti colonne ho dei dati, anche ripetuti, vorrei creare una macro con una una inputbox che mi consenta di cercare in un determinato range dal 10/02/2017   al  24/03/2017 (che immetterò io)  la parola "pera" (che immetterò io) e sostituirla con la parola "mela" (che immetterò io) del tutto in similitudine con quella che propone Excel, rimanendo inalterate le altre.

In poche parole se io in un foglio Excel seleziono solo una parte delle righe e aziono il trova e sostituisci saranno sostituiti solo i valori evidenziati nella selezione gli altri rimangono inalterati quest'azione la vorrei automatizzare con una macro. Grazie per la vostra attenzione , sempre preziosa.

Answer 1

Ciao Mykia55,

Grazie Norman è stato utile il tuo intervento, ho modificato il tuo listato secondo le mie esigenze

(in realtà poche ed insignificanti righe) il foglio dove cambiare i dati era nascosto e tale doveva rimanere

infatti ho dato la proprietà Sheets("mio foglio").Visible = xlSheetVeryHidden.

ed ho spostato il pulsante sull'unico foglio visibile all'apertura...

la tua routine è diventata:

Non avrei potuto prevedere questo scenario prima che  tu lo spiegassi!

[cut]

un'ultima cosa  per l'inputbox sarebbe carino che si apra al centro schermo e che

la schermata del trova e sostituisci non presentasse , ad una riapertura i valori precedentemente

utilizzati.... nonostante  Application.screenupdating=False un leggero sfarfallio si avverte ma...

Grazie comunque...

Alla Prossima per me sei stato più che esaustivo.

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Private Declare Function UnhookWindowsHookEx Lib "user32" _

                                             (ByVal hHook As Long) As Long

'--------->>

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'--------->>

Private Declare Function SetWindowsHookEx Lib "user32" _

                                          Alias "SetWindowsHookExA" ( _

                                          ByVal idHook As Long, _

                                          ByVal lpfn As Long, _

                                          ByVal hmod As Long, _

                                          ByVal dwThreadId As Long) As Long

'--------->>

Private Declare Function SetWindowPos Lib "user32" _

                                      (ByVal hwnd As Long, _

                                       ByVal hWndInsertAfter As Long, _

                                       ByVal x As Long, _

                                       ByVal y As Long, _

                                       ByVal cx As Long, _

                                       ByVal cy As Long, _

                                       ByVal wFlags As Long) As Long

Private hHook As Long

Private Const WH_CBT = 5

Private Const HCBT_ACTIVATE = 5

Private Const SWP_NOSIZE = &H1

Private Const SWP_NOZORDER = &H4

Dim iTop As Long

Dim iLeft As Long

'--------->>

Private Function MsgBoxHookProc(ByVal lMsg As Long, _

                                ByVal wParam As Long, ByVal lParam As Long) As Long

    If lMsg = HCBT_ACTIVATE Then

        SetWindowPos wParam, 0, iLeft, iTop, _

                     0, 0, SWP_NOSIZE + SWP_NOZORDER

        UnhookWindowsHookEx hHook

    End If

    MsgBoxHookProc = False

End Function

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim RngDates As Range, RngSearch As Range

    Dim RngStart As Range, RngEnd As Range

    Dim Res As Variant, Res2 As Variant

    Dim arrDate As Variant

    Dim dStart As Date

    Dim dEnd As Date

    Dim vVar As Variant, vVar2 As Variant

    Dim sMsg As String

    Dim i As Long, j As Long, iCol As Long, jCol As Long

    Dim iStart As Long, iEnd As Long, UB As Long

    Dim MidRow As Long, MidCol As Long

    Const sColonnaDate As String = "B"                   '<<=== Modifica

    Const sFoglio As String = "Mio Foglio"               '<<=== Modifica

    hHook = SetWindowsHookEx(WH_CBT, _

                             AddressOf MsgBoxHookProc, 0, _

                             GetCurrentThreadId)

    With ActiveWindow.VisibleRange

        MidRow = .Rows.Count / 1.2

        MidCol = .Columns.Count / 2

    End With

    With Cells(MidRow, MidCol)

        iTop = .Top

        iLeft = .Left

    End With

    Res = Application.InputBox(Prompt:="Immetti data dell'Inizio", _

                               Title:="DATA INIZIO", Type:=2, _

                               Left:=iLeft, _

                               Top:=iTop)

    On Error Resume Next

    vVar = DateValue(Res)

    On Error GoTo 0

    If Not IsEmpty(vVar) Then

        dStart = vVar

    Else

        sMsg = "Hai omesso la data di inizio!"

        GoTo XIT

    End If

    Res2 = Application.InputBox( _

           Prompt:="Immetti data del fine", _

           Title:="DATA FINE", _

           Type:=2)

    On Error Resume Next

    vVar2 = DateValue(Res2)

    On Error GoTo 0

    If Not IsEmpty(vVar2) Then

        dEnd = vVar2

    Else

        sMsg = "Hai omesso la data di fine!"

        GoTo XIT

    End If

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    On Error GoTo XIT

    Application.ScreenUpdating = False

    With SH

        .Visible = True

        .Select

        Set RngDates = Intersect(.UsedRange, .Columns(sColonnaDate))

        With .UsedRange

            iCol = .Columns(.Columns.Count).Column

        End With

        jCol = .Columns(sColonnaDate).Column

    End With

    arrDate = RngDates.Value

    UB = UBound(arrDate)

    For i = 2 To UB

        If arrDate(i, 1) >= dStart Then

            iStart = i

            Exit For

        End If

    Next i

    For j = i To UB

        If arrDate(j, 1) >= dEnd Then

            iEnd = j

            Exit For

        End If

    Next j

    If iEnd = 0 Then

        iEnd = UB

    End If

    Set RngSearch = RngDates.Offset(iStart - 1, 1) _

                    .Resize(iEnd - iStart + 1, iCol - jCol)

    RngSearch.Select

    Application.Dialogs(xlDialogFormulaReplace).Show

XIT:

    If Not SH Is Nothing Then

        SH.Visible = xlSheetVeryHidden

    End If

    Application.ScreenUpdating = True

    If sMsg <> vbNullString Then

        Call MsgBox( _

             Prompt:=sMsg, _

             Buttons:=vbCritical, _

             Title:="ATTENZIONE")

    End If

End Sub

'<<=========

Nota che ho anche modificato le tue modifiche precedenti.

===

Regards,

Norman

Answer 2

Grazie Norman è stato utile il tuo intervento, ho modificato il tuo listato secondo le mie esigenze

(in realtà poche ed insignificanti righe) il foglio dove cambiare i dati era nascosto e tale doveva rimanere

infatti ho dato la proprietà Sheets("mio foglio").Visible = xlSheetVeryHidden.

ed ho spostato il pulsante sull'unico foglio visibile all'apertura...

la tua routine è diventata:

'--------->>

Public Sub Tester()

 Application.ScreenUpdating = False

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim RngDates As Range, RngSearch As Range

    Dim RngStart As Range, RngEnd As Range

    Dim Res As Variant, Res2 As Variant

    Dim arrDate As Variant

    Dim dStart As Date

    Dim dEnd As Date

    Dim vVar As Variant, vVar2 As Variant

    Dim sMsg As String

    Dim i As Long, j As Long, iCol As Long, jCol As Long

    Dim iStart As Long, iEnd As Long, UB As Long

Const sColonnaDate As String = "B"               '<<=== Modifica

Res = Application.InputBox(Prompt:="Immetti data dell'Inizio", _

                               Title:="Data Inizio ricerca", _

                               Type:=2)

On Error Resume Next

    vVar = DateValue(Res)

    On Error GoTo 0

If Not IsEmpty(vVar) Then

        dStart = vVar

    Else

        sMsg = "Hai omesso la data di inizio!"

        GoTo XIT

    End If

Res2 = Application.InputBox(Prompt:="Immetti la data di fine", _

                                Title:="Data fine ricerca", _

                                Type:=2)

On Error Resume Next

    vVar2 = DateValue(Res2)

    On Error GoTo 0

If Not IsEmpty(vVar2) Then

        dEnd = vVar2

    Else

        sMsg = "Hai omesso la data di fine!"

        GoTo XIT

    End If

Set WB = ThisWorkbook

    Sheets("Mio Foglio").Visible = True

    Sheets("Mio Foglio").Select

    Set SH = Sheets("Mio Foglio")

With SH

        Set RngDates = Intersect(.UsedRange, .Columns(sColonnaDate))

        With .UsedRange

            iCol = .Columns(.Columns.Count).Column

        End With

        jCol = .Columns(sColonnaDate).Column

    End With

arrDate = RngDates.Value

    UB = UBound(arrDate)

For i = 2 To UB

        If arrDate(i, 1) >= dStart Then

            iStart = i

            Exit For

        End If

    Next i

For j = i To UB

        If arrDate(j, 1) >= dEnd Then

            iEnd = j

            Exit For

        End If

    Next j

If iEnd = 0 Then

        iEnd = UB

    End If

Set RngSearch = RngDates.Offset(iStart - 1, 1) _

                    .Resize(iEnd - iStart + 1, iCol - jCol)

    RngSearch.Select

    Application.Dialogs(xlDialogFormulaReplace).Show

     Sheets("Mio Foglio").Visible = xlSheetVeryHidden

Exit Sub

XIT:

    Call MsgBox( _

         Prompt:=sMsg, _

         Buttons:=vbCritical, _

         Title:="ATTENZIONE")

Application.ScreenUpdating = True

End Sub

'--------->>

un'ultima cosa  per l'inputbox sarebbe carino che si apra al centro schermo e che

la schermata del trova e sostituisci non presentasse , ad una riapertura i valori precedentemente

utilizzati.... nonostante  Application.screenupdating=False un leggero sfarfallio si avverte ma...

Grazie comunque...

Alla Prossima per me sei stato più che esaustivo.

Answer 3

Ciao Mykia55,

Ho un foglio Excel che è composto da n righe ed m colonne la prima colonna contiene un numero o una data (meglio la data) a partire , per esempio, dal 01/01/2017. Nelle restanti colonne ho dei dati, anche ripetuti, vorrei creare una macro con una una inputbox che mi consenta di cercare in un determinato range dal 10/02/2017   al  24/03/2017 (che immetterò io)  la parola "pera" (che immetterò io) e sostituirla con la parola "mela" (che immetterò io) del tutto in similitudine con quella che propone Excel, rimanendo inalterate le altre.

In poche parole se io in un foglio Excel seleziono solo una parte delle righe e aziono il trova e sostituisci saranno sostituiti solo i valori evidenziati nella selezione gli altri rimangono inalterati quest'azione la vorrei automatizzare con una macro. 

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IMper inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim RngDates As Range, RngSearch As Range

    Dim RngStart As Range, RngEnd As Range

    Dim Res As Variant, Res2 As Variant

    Dim arrDate As Variant

    Dim dStart As Date

    Dim dEnd As Date

    Dim vVar As Variant, vVar2 As Variant

    Dim sMsg As String

    Dim i As Long, j As Long, iCol As Long, jCol As Long

    Dim iStart As Long, iEnd As Long, UB As Long

    Const sColonnaDate As String = "A"               '<<=== Modifica

    Res = Application.InputBox(Prompt:="Immetti data dell'Inizio", _

                               Title:="DATA INIZIO", _

                               Type:=2)

    On Error Resume Next

    vVar = DateValue(Res)

    On Error GoTo 0

    If Not IsEmpty(vVar) Then

        dStart = vVar

    Else

        sMsg = "Non hai imesso ina data di inizio!"

        GoTo XIT

    End If

    Res2 = Application.InputBox(Prompt:="Immetti data del fine", _

                                Title:="DATA FINE", _

                                Type:=2)

    On Error Resume Next

    vVar2 = DateValue(Res2)

    On Error GoTo 0

    If Not IsEmpty(vVar2) Then

        dEnd = vVar2

    Else

        sMsg = "Non hai imesso ina data di fine!"

        GoTo XIT

    End If

    Set WB = ThisWorkbook

    Set SH = ActiveSheet

    With SH

        Set RngDates = Intersect(.UsedRange, .Columns(sColonnaDate))

        With .UsedRange

            iCol = .Columns(.Columns.Count).Column

        End With

        jCol = .Columns(sColonnaDate).Column

    End With

    arrDate = RngDates.Value

    UB = UBound(arrDate)

    For i = 2 To UB

        If arrDate(i, 1) >= dStart Then

            iStart = i

            Exit For

        End If

    Next i

    For j = i To UB

        If arrDate(j, 1) >= dEnd Then

            iEnd = j

            Exit For

        End If

    Next j

    If iEnd = 0 Then

        iEnd = UB

    End If

    Set RngSearch = RngDates.Offset(iStart - 1, 1) _

                    .Resize(iEnd - iStart + 1, iCol - jCol)

    RngSearch.Select

    Application.Dialogs(xlDialogFormulaReplace).Show

    Exit Sub

XIT:

    Call MsgBox( _

         Prompt:=sMsg, _

         Buttons:=vbCritical, _

         Title:="REPORT")

End Sub

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

In alternativa, potresti considerare l'uso di una Userform.

Potresti scaricare il mio file di prova Mykia20170329.xlsm a:

https://www.dropbox.com/s/ukkpo4hcmg2h4fv/Mykia20170329.xlsm?dl=0

===

Regards,

Norman