modifica macro "trova"

Versione Completa   Stampa   Cerca   Utenti   Iscriviti     Condividi : FacebookTwitter
patrik01
00sabato 7 gennaio 2017 20:04
Ciao a tutti,
un aiuto per modificare questa macro nel workbook allegato:


'Option Explicit

'per filtrare codice
Sub ApplicaFiltro1()

ActiveSheet.Unprotect "123456"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '<=== riga aggiunta
Dim c As String
c = Range("C1")

'c = c & "*"  '<<< trova all'inizio della parola
c = "*" & c & "*" '<<< trova in mezzo alle parole

Set y = Range("A3:A40000")

If Range("C1") = "inserisci qui" Then
MsgBox "Inserire un'articolo da ricercare!", vbInformation, "AVVISO!"
'Range("C1").Select
End If
'Exit Sub

'Range("C1").Select

If Application.WorksheetFunction.CountIf(y, c) = 0 Then

MsgBox "nessun elemento trovato!", vbInformation, "AVVISO!"

Range("C1") = Null
Range("C1").Select
Else
ActiveSheet.Range("$A$2:$A$40000").AutoFilter Field:=1, Criteria1:=c
End If


Application.Calculation = xlAutomatic '<== riga aggiunta
Application.ScreenUpdating = True
ActiveSheet.Protect "123456"
'TogliFiltro
End Sub


la macro serve per trovare determinati valori del range A3:A40000
scrivendoli nella cella C1.
Funziona bene ma non riescro a togliere l'avviso:

MsgBox "nessun elemento trovato!", vbInformation, "AVVISO!"

se non scrivo nulla nella cella C1.
Non scrivendo nulla nella cella C1 e cliccando "TROVA" deve
visualizzarsi solo l'avviso:

MsgBox "Inserire un'articolo da ricercare!", vbInformation, "AVVISO!"

spero di essermi spiegato.
Un saluto.
patrik
federico460
00sabato 7 gennaio 2017 20:59
caio
cambia questa riga

If Application.WorksheetFunction.CountIf(y, c) = 0 Then



con


If Application.WorksheetFunction.CountIf(y, c) = 0 And Range("C1") <> "inserisci qui" Then

patel45
00sabato 7 gennaio 2017 21:01
Sub ApplicaFiltro1()

ActiveSheet.Unprotect "123456"
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '<=== riga aggiunta
Dim c As String
c = Range("C1")

'c = c & "*"  '<<< trova all'inizio della parola
c = "*" & c & "*" '<<< trova in mezzo alle parole

Set y = Range("A3:A40000")

If Range("C1") = "inserisci qui" Then
   MsgBox "Inserire un'articolo da ricercare!", vbInformation, "AVVISO!"
   Exit Sub
End If
If Application.WorksheetFunction.CountIf(y, c) = 0 Then
  MsgBox "nessun elemento trovato!", vbInformation, "AVVISO!"
  Range("C1") = "inserisci qui"
  Range("C1").Select
Else
  ActiveSheet.Range("$A$2:$A$40000").AutoFilter Field:=1, Criteria1:=c
End If
Application.Calculation = xlAutomatic '<== riga aggiunta
Application.ScreenUpdating = True
ActiveSheet.Protect "123456"
'TogliFiltro
End Sub
federico460
00sabato 7 gennaio 2017 21:09
ciao
patel

vero
ho visto ora che exit sub
era scritto 'exit sub
disattivando di fatto il comando [SM=g27818]
patrik01
00sabato 7 gennaio 2017 21:29
Grazie a tutti,
la modifica di federico460 funziona in parte: dopo aver cliccato "TROVA" si attiva il fitro che poi di bisogna togliere.
La macro di patel45 funziona bene.
Un saluto a tutti.
Grazie,
patrik
Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 06:07.
Copyright © 2000-2024 FFZ srl - www.freeforumzone.com