Modifica macro, VBA, button

di
898989_mt
il
1 risposte
8
898989_mt
Pochi posts
Iscritto da
mag, 2018
Messaggi:
1

Modifica macro, VBA, button

Salve, ho scritto una macro assegnandola ad un "button". Cliccando sul "button" si apre una finestra all'interno del quale si scrivo cosa voglio cercare. Questa macro mi va a leggere e filtrare i dati nella prima colonna del foglio che ho chiamato "data base" e mi va a copiare nel foglio Risultati le righe corrispondenti agli elementi cercati. il button è stato posizionato nel foglio cerca

come posso modificare la macro, nel caso in cui scrivo una parola no presente, per ottenere la comparsa della finestra con il messaggio elemento non trovato?

https://we.tl/wPo6xLsVR

riporto di seguito la macro

Private Sub CommandButton1_Click()
Dim priga As Long, ur As Long, uriga As Long, ur1 As Long
Dim sh As Worksheet, sh1 As Worksheet
Dim TextToFind As String

Set sh = Sheets("DATABASE")
Set sh1 = Sheets("RISULTATI")

TextToFind = InputBox("Cosa vuoi cercare?")

With sh
.Activate

uriga = .Range("a" & Rows.Count).End(xlUp).Row

ActiveSheet.ListObjects("Tabella2").Range.AutoFilter Field:=1, Criteria1:= _
TextToFind

priga = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Row
ur = Range("a2:a" & uriga).SpecialCells(xlCellTypeVisible).Count

ur1 = sh1.Range("a" & Rows.Count).End(xlUp).Row

sh1.Range("a1:e" & ur1).ClearContents
.Range(.Cells(priga, 1), .Cells(priga + ur, 5)).Copy sh1.Cells(1, 1)

sh.Range("A2").Select
Selection.AutoFilter



End With

Set sh = Nothing
Set sh1 = Nothing
End Sub[/b]

1 Risposte

  • C
    CarlettoFed
    Utente Attivo
    Iscritto da
    giu, 2017
    Messaggi:
    143

    Re: Modifica macro, VBA, button

    Il codice è il seguente: 
    
Sub CommandButton1_Click()
Dim priga As Long, ur As Long, uriga As Long, ur1 As Long
Dim sh As Worksheet, sh1 As Worksheet
Dim TextToFind As String

    Set sh = Sheets("DATABASE")
    Set sh1 = Sheets("RISULTATI")
    
    TextToFind = InputBox("Cosa vuoi cercare?")
    
    With sh
        .Activate
        uriga = .Range("a" & Rows.Count).End(xlUp).Row
        ActiveSheet.Range("Tabella2").AutoFilter Field:=1, Criteria1:="=" & TextToFind
        priga = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeVisible).Row
        
        'pulizia del foglio di destinazione
        ur1 = sh1.Range("a1").End(xlDown).Row
        sh1.Range("a1:e" & ur1).ClearContents
        
        'verifica la ricerca
        If .Range("a1").End(xlDown) = "" Then
            'la ricerca è negativa
            MsgBox " Elemento non trovato!", vbInformation, "Ricerca"
        Else
            'la ricerca è positiva
            ur = .Range("a2:a" & uriga).SpecialCells(xlCellTypeVisible).Count
            .Range(.Cells(priga, 1), .Cells(priga + ur, 5)).Copy sh1.Cells(1, 1)
            MsgBox " Elemento trovato!", vbInformation, "Ricerca"
        End If
        
        sh.Range("A2").Select
        Selection.AutoFilter
    End With
    
    Set sh = Nothing
    Set sh1 = Nothing
End Sub
Devi accedere o registrarti per scrivere nel forum
1 risposte