Aiutamici Forum
Benvenuto Ospite Cerca | Topic Attivi | Utenti | | Log In | Registra

Come avere da un scheda rieplogo, l'elenco di altre schede? Opzioni
marius44
Inviato: Sunday, November 22, 2020 5:30:17 PM
Rank: Member

Iscritto dal : 9/7/2015
Posts: 22
Ciao

@lui49
Non credo abbia senso escludere quella riga di codice.
Siamo all'interno di un ciclo che, prima della verifica della condizione, ha la riga di codice Set c = .FindNext(c)

Ciao,
Mario
lui49
Inviato: Sunday, November 22, 2020 8:40:43 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Grazie Mario
Stavo solo cercando di ripuglirgli il più possibile il codice (visto che 'c' viene rigenerato da Find per ogni ciclo 'for I' e risulta ridondante il Select) per cercare di capire da dove tira fuori l'istruzione di scrivere dopo 999 righe che non riesco a riprodurre..
clem
Inviato: Monday, November 23, 2020 10:17:38 AM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
Ringrazio marius44 per l'intervento...

Ho sostituito le righe di codice come suggerito da entrambi: adesso la macro restituisce i valori a inizio foglio , preceduto da una sola riga tipo

1 $H$1 Cerca
poi subito sotto i valori utili...
Va bene anche così.
Ringrazio lui49 per la pazienza e disponibilità che ha avuto in tuto questo percorso e naturalmente marius44.
lui49
Inviato: Monday, November 23, 2020 1:20:45 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
clem ha scritto:
.....

1 $H$1 Cerca
.....


H1 è solo la cella, presa una a caso, di posizionamento del cursore a fine operazione e 'Cerca' non capisco da dove salti fuori.

Dove hai posizionato il pulsante 'cerca'?

E occorre ripristinare c.Select, avevo fatto la prova con altri criteri.

Copia e incolla qui il tuo codice .....
marius44
Inviato: Monday, November 23, 2020 3:17:37 PM
Rank: Member

Iscritto dal : 9/7/2015
Posts: 22
Ciao
nella macro ci sono queste righe
Cells(1, 1) = "La ricerca di ''" & TextToFind & "'', ha dato i seguenti risultati:"
Cells(2, 1) = "Rec"
Cells(2, 2) = "Posizione"
Cells(2, 3) = "Foglio"
Cells(2, 4) = "Record"
quindi, se ti dà quelle risposte abbiamo:
col.A - num.progressivo
col.B - posizione
col.C - Foglio
col.D - record

Infatti col.A 1, col.B l'indirizzo della cella, col.C il nome del Foglio, col. D vuoto


Forse quando lanci la macro (anche se non vedo un motivo logico) la cella selezionata è H1 ?
Ma non capisco.

Ciao,
Mario
clem
Inviato: Tuesday, November 24, 2020 8:07:04 AM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
questo è il codice:

Sub Trova()
Dim I As Integer, Z As Integer
Dim TextToFind As String, Area As String
Application.ScreenUpdating = False
Area = "A1:Y1000" ' Definisce l'area di ricerca
Z = 0
TextToFind = InputBox("Nome?")
If TextToFind = "" Then End
Sheets("Cerca").Select
Cells.ClearContents
Cells(1, 1) = "La ricerca di ''" & TextToFind & "'', ha dato i seguenti risultati:"
Cells(2, 1) = "Rec"
Cells(2, 2) = "Posizione"
Cells(2, 3) = "Foglio"
Cells(2, 4) = "Record"
For I = 1 To Sheets.Count
Sheets(I).Select
With ActiveSheet.Range(Area)
Set c = .Find(TextToFind, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'c.Select
Z = Z + 1
Range("Cerca!A" & Z + 2) = Z
Range("Cerca!B" & Z + 2) = ActiveCell.Address
Range("Cerca!C" & Z + 2) = Sheets(I).Name
Range("Cerca!D" & Z + 2) = ActiveCell
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next I
Application.ScreenUpdating = True
Sheets("Cerca").Select
Range("H1").Select
End Sub

Sub Cancella()
'ActiveSheet.Protect DrawingObjects:=False, contents:=False, Scenarios:=False

Sheets("Cerca").Select
Range("A1:Y1000").ClearContents ' cancella il contentuto del range
'ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True

End Sub



Il pulsante cerca è in H4
marius44
Inviato: Tuesday, November 24, 2020 10:18:31 AM
Rank: Member

Iscritto dal : 9/7/2015
Posts: 22
Ciao
Credo d'aver capito.
Il Foglio("Cerca") in che posizione si trova?
Se è l'ultimo Foglio in elenco allora va bene For I = 1 To Sheets.Count - 1
Se, invece, è il primo Foglio allora deve essere For I = 2 To Sheets.Count
Per tagliare la testa al toro io inizierei il ciclo così

For I = 1 To Sheets.Count 'SENZA IL -1
Sheets(I).Select
If Sheets(I).Name = "Cerca" Then GoTo nxt 'RIGA AGGIUNTA

e, prima del Next i
nxt: 'RIGA AGGIUNTA
Next I

Riposto la macro come detto (a me funziona regolarmente).

Code:

Sub Trova()
Dim I As Integer, Z As Integer
Dim TextToFind As String, Area As String
Application.ScreenUpdating = False
    Area = "A1:Y1000"  '   Definisce l'area di ricerca
    Z = 0
    TextToFind = InputBox("Nome?")
    If TextToFind = "" Then End
    Sheets("Cerca").Select
    Cells.ClearContents
    Cells(1, 1) = "La ricerca di ''" & TextToFind & "'', ha dato i seguenti risultati:"
    Cells(2, 1) = "Rec"
    Cells(2, 2) = "Posizione"
    Cells(2, 3) = "Foglio"
    Cells(2, 4) = "Record"
    For I = 1 To Sheets.Count
        Sheets(I).Select
        If Sheets(I).Name = "Cerca" Then GoTo nxt
        With ActiveSheet.Range(Area)
            Set c = .Find(TextToFind, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Select
                    Z = Z + 1
                    Range("Cerca!A" & Z + 2) = Z
                    Range("Cerca!B" & Z + 2) = ActiveCell.Address
                    Range("Cerca!C" & Z + 2) = Sheets(I).Name
                    Range("Cerca!D" & Z + 2) = ActiveCell
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
nxt:
    Next I
Application.ScreenUpdating = True
    Sheets("Cerca").Select
    Range("H1").Select
End Sub

Prova e fai sapere.
Ciao,
Mario
lui49
Inviato: Tuesday, November 24, 2020 10:32:24 AM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
lui49 ha scritto:
Facciamo una prova. Usiamo un foglio aggiuntivo.
Aggiungi alla fine dei fogli di lavoro (clic destro sull’ultimo foglio-->inserisci-->foglio di lavoro) e
rinominalo in “Cerca”....



La macro è impostata su questa istruzione.

Sostituire ('c.Select con c.Select) ...
lui49
Inviato: Thursday, November 26, 2020 12:03:37 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Allora:

se uso il tuo codice, seppure uguale al mio, ottengo gli errori che hai evidenziato

Vediamo: dopo che hai inserito il foglio 'cerca' dopo gli altri fogli lo hai anche spostato 'alla fine'?

Ri-copia e Ri-incolla tutto questo codice così come sta senza toccare nulla (il codice visual andrebbe scritto a mano, il copia/incolla a volte non viene recepito):

Code:
Sub Trova()
Dim I As Byte, Z As Byte
Dim TextToFind As String, Area As String

Application.ScreenUpdating = False
    Area = "A1:Z1000"  '   Definisce l'area di ricerca
         Z = 0
   
    TextToFind = InputBox("Nome?")
    If TextToFind = "" Then End
   
    Sheets("Cerca").Select
    Cells.ClearContents
    Range("D3").Select
    Cells(1, 1) = "La ricerca di ''" & TextToFind & "'', ha dato i seguenti risultati:"
    Cells(2, 1) = "Rec"
   Cells(2, 2) = "Posizione"
    Cells(2, 3) = "Foglio"
    Cells(2, 4) = "Record"
    For I = 1 To Sheets.Count - 1
        Sheets(I).Select
        Range(Area).Interior.ColorIndex = xlNone
        With ActiveSheet.Range(Area)
            Set c = .Find(TextToFind, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Select
                    Z = Z + 1
                    Range("Cerca!A" & Z + 2) = Z
                    Range("Cerca!B" & Z + 2) = ActiveCell.Address
                    Range("Cerca!C" & Z + 2) = Sheets(I).Name
                    Range("Cerca!D" & Z + 2) = ActiveCell
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next I
Application.ScreenUpdating = True
    Sheets("Cerca").Select
    Range("H1").Select
End Sub

Sub Cancella()
Sheets("Cerca").Select
Range("A1:Z1000").ClearContents ' cancella il contentuto del range
End Sub


Vediamo
clem
Inviato: Thursday, November 26, 2020 1:23:43 PM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
@marius44: Il foglio Cerca è in ultima posizione, dopo tutti i fogli di lavoro....


@lui49: ho provato a copiare il codice e rimetterlo nella macro foglio"cerca" già esistente ma restituisce l'errore run-time 6 .


Provo ad eliminare il foglio cerca e crearne un altro , sempre in fondo a tutti gli altri, ricreando il tasto cerca e copiando per intero il codice di lui49..... farò sapere.
lui49
Inviato: Thursday, November 26, 2020 1:52:30 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Hai ragione, cribbio, ti ho messo la macro sbagliata, ora rimedio:

Code:
Sub Trova()
Dim I As Integer, Z As Integer
Dim TextToFind As String, Area As String
Application.ScreenUpdating = False
    Area = "A1:Y1000"  '   Definisce l'area di ricerca
         Z = 0
    TextToFind = InputBox("Nome?")
    If TextToFind = "" Then End
    Sheets("Cerca").Select
    Cells.ClearContents
    Cells(1, 1) = "La ricerca di ''" & TextToFind & "'', ha dato i seguenti risultati:"
    Cells(2, 1) = "Rec"
   Cells(2, 2) = "Posizione"
    Cells(2, 3) = "Foglio"
    Cells(2, 4) = "Record"
    For I = 1 To Sheets.Count - 1
        Sheets(I).Select
        With ActiveSheet.Range(Area)
            Set c = .Find(TextToFind, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Select
                    Z = Z + 1
                    Range("Cerca!A" & Z + 2) = Z
                    Range("Cerca!B" & Z + 2) = ActiveCell.Address
                    Range("Cerca!C" & Z + 2) = Sheets(I).Name
                    Range("Cerca!D" & Z + 2) = ActiveCell
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next I
Application.ScreenUpdating = True
    Sheets("Cerca").Select
    Range("H1").Select
End Sub

Sub Cancella()
Sheets("Cerca").Select
Range("A1:Y1000").ClearContents ' cancella il contentuto del range
End Sub
clem
Inviato: Sunday, November 29, 2020 5:30:35 PM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
Ho ricreato il foglio Cerca e nella colonna H il pulsante cerca; copiato la macro con ALT F11 in modulo 1 : appaiono i risultati cercati ma questa volta di nuovo dopo 999 riche....probabilmente sbaglio io qualcosa ma non ti so dire dove...
lui49
Inviato: Sunday, November 29, 2020 6:12:38 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Non so più cosa dirti....

Proviamo a ripiegare sulla funzione 'Trova' dal menu di 'modifica' della barra di excel. Digita per 'Trova' -> nome da cercare, (poi apri 'opzioni')
per 'in' >cartella di lavoro, per 'cerca'->per righe, per 'cerca in' ->valori e metti la spunta a 'Maiuscole/minuscole' così prendi dentro tutto. Pigia 'Trova tutti' e li avrai sottomano e clic-raggiungibili.
bobo779256
Inviato: Monday, November 30, 2020 12:23:26 PM

Rank: AiutAmico

Iscritto dal : 4/8/2011
Posts: 4,080
Se non ho capito male, magari ti basta una cosa simile a questa:



cioè in B3 inserisco il nome da cercare nei fogli di nome 'maschi'-'femmine'-'boh'

Nella colonna B celle 6-9-12 vengono riportate le posizioni del nome da cercare nei reletivi fogli

Nella colonna D celle 6-9-12 vengono riportati i nomi dei fogli che contengono il nome da cercare

L'ho fatto con OpenOffice, ho comunque creato un file con Excel 2010

Se vuoi\volete li allego

Se invece non ho capito una mazza, scusate e ignoratemi



P.S.: il foglio 'boh' voleva essere solo un elenco di persono di cui non conosco nulla, gli altri due fogli sono elenchi di nomi che conosco maschi\femmine, solo per test, non pensate male...
clem
Inviato: Tuesday, December 01, 2020 7:34:09 AM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
Grazie a bobo779256 per il tuo intervento....
@lui49: sono ritornato ad usare la macro precedente ovvero quella che mi dava i risultati sotto una sola riga senza senso....ho provato la funziona "Trova" ma preferisco l'altra con la macro è più performante...

Ringrazio veramente tutti, ed in particolare lui49.
Una buona giornata a tutti e grazie ancora!
lui49
Inviato: Tuesday, December 01, 2020 4:03:01 PM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Io sono come San Tommaso...che ci vuole mettere naso.
Riesci a postare uno screenshot del modulo?
clem
Inviato: Wednesday, December 02, 2020 10:44:37 AM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103
Ho realizzato degli screenshot e li ho incollati su un file word...ma non so come inserirlo...mannaggia...
lui49
Inviato: Wednesday, December 02, 2020 11:27:26 AM
Rank: AiutAmico

Iscritto dal : 5/4/2003
Posts: 2,833
Vai su questo sito , scegli l'immagine (nel tuo caso il file word) da caricare, copia tutto il 'collegamento diretto per forum' e incollalo nel post.
clem
Inviato: Thursday, December 03, 2020 4:17:22 PM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103


Sperando che il caricamento sia andato a buon fine....
clem
Inviato: Thursday, December 03, 2020 4:25:07 PM
Rank: AiutAmico

Iscritto dal : 4/27/2004
Posts: 103






Utenti presenti in questo topic
Guest


Salta al Forum
Aggiunta nuovi Topic disabilitata in questo forum.
Risposte disabilitate in questo forum.
Eliminazione tuoi Post disabilitata in questo forum.
Modifica dei tuoi post disabilitata in questo forum.
Creazione Sondaggi disabilitata in questo forum.
Voto ai sondaggi disabilitato in questo forum.

Main Forum RSS : RSS

Aiutamici Theme
Powered by Yet Another Forum.net versione 1.9.1.8 (NET v2.0) - 3/29/2008
Copyright © 2003-2008 Yet Another Forum.net. All rights reserved.