Risolto cerca valore su più fogli

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
Buongiorno,
avrei la necessità di creare un comando vba cerca di un valore su più fogli, che mi restituisca tutte le righe intere trovate. allego il file.
il risultato deve comparire sul Foglio 6 del file allegato.
il valore da ricercare è sempre diverso ma contenuto sempre nella colonna A di ogni foglio, quindi avrei pensato ad una test box di ricerca.

GRazie in anticipo
 

Allegati

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
S @small31

Fai un esempio concreto del risultato che vuoi ottenere inserendolo a mano.
 

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
Scusa S @small31 ma puoi spiegare come viene a determinarsi il risultato atteso in Foglio6?
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
Provo a spiegarmi: data un valore variabile, nel mio caso 18-006-00 la macro dovrebbe cercare tale valore in tutti i fogli e riportare sul foglio6 tutte le righe che comprendono tale valore, come nell'esempio evidenziato da me in foglio6
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
ho modificato una macro presente in questo forum in questo modo:

Codice:
Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim ricerca As String
        With Sheets("base")
        ricerca = InputBox("Scrivi la parola da cercare")
        .Range("A2").EntireRow.Copy Sheets("Risultati").Cells(1, 1)
        For y = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            For x = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
                If UCase(.Cells(y, x)) Like UCase("*" & ricerca & "*") Then
                    uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(y, x).EntireRow.Copy
                    Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                End If
            Next x
        Next y
    End With
    Application.CutCopyMode = False
End Sub
cosi funziona ma solo su un foglio, vorrei ampliarlo su tutti i fogli presenti, inoltre vorrei che mi tenesse l'intestazione invece con questa macro la cancella e la sostituisce,
Riallego il file con il pulsante macro chiamato RICERCA.

Grazie in anticipo
 

Allegati

Ultima modifica di un moderatore:

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
S @small31

Ma perchè sui vari fogli i nomi dei campi (colonne) e posizione sono diversi?

Se fossero uguali sarebbe tutto più semplice.

Riesci a riallegare il file con l'intestazione dei fogli uguale e relativa redistribuzione dei dati?

Non conoscendo il tuo lavoro non posso farlo io.
 

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
Poi una considerazione.

Io eviterei l'uso di tanti fogli; ne terrei uno solo dove aggiungere un campo (es. Tipo) dove codificherei in base alla tipologia (base, IN LAV etc).

A quel punto probabilmente ti basterebbe un banale filtro (sempre che abbia ben capito l'esigenza).
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
se posso aiutarti in qualche modo posso solo dirti che il dato che è il valore da ricercare è sempre contenuto nella colonna A di tutti i fogli.
 

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
Si ma se sul foglio4 vedo il campo QUANTITA' mi aspetto di trovarci un numero non un codice (A8014A16)

E perchè questo stesso codice sul foglio IN LAV sta nel campo "Part Number"?

Ripeto per me le intestazioni delle tabelle devono essere uguali e in ogni campo ci deve andare lo stesso tipo di dato.

Poi magari mi sbaglio ma non è così che si strutturano i database.
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
Hai perfettamente ragione non fare caso a quello scritto sotto ero un po' di corsa, quel che conta è l'intestazione, e per certo è uguale su tutti i fogli
 

alfrimpa

VBA Expert
Supermoderatore
Expert
18 Dicembre 2015
18.100
113
65
Napoli
2013
320
Hai perfettamente ragione non fare caso a quello scritto sotto ero un po' di corsa, quel che conta è l'intestazione, e per certo è uguale su tutti i fogli
Allora, quando potrai riallega il file corretto con le intestazioni giuste e la redistribuzione dei dati corretta.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
18.883
113
Como
2011MAC 2016WIN
356
Ciao, un saluto a Alfredo cappello_saluta
prova così
Visual Basic:
Option Compare Text
Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim fg As Integer
    Dim ricerca As String
    ricerca = InputBox("Scrivi la parola da cercare")
    Application.ScreenUpdating = False
    For fg = 1 To Sheets.Count
        If Sheets(fg).Name <> "Risultati" Then
            For y = 2 To Sheets(fg).Cells(Rows.Count, 1).End(xlUp).Row
                For x = 1 To Sheets(fg).Cells(1, Columns.Count).End(xlToLeft).Column
                    If Sheets(fg).Cells(y, x) Like "*" & ricerca & "*" Then
                        uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                        Sheets(fg).Cells(y, x).EntireRow.Copy
                        Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                    End If
                Next x
            Next y
        End If
    Next fg
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Fai attenzione però che con l'operatore "Like" così come lo hai scritto trovi tutte le righe che contengono la parte ricercata.
 
  • Like
Reactions: Vincenzo Damiani

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
e' perfetta. ora avrei la necessità di selezionare dopo un filtro le celle visibili per poterle tagliare e incollare su altro foglio
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
Ciao, un saluto a Alfredo cappello_saluta
prova così
Visual Basic:
Option Compare Text
Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim fg As Integer
    Dim ricerca As String
    ricerca = InputBox("Scrivi la parola da cercare")
    Application.ScreenUpdating = False
    For fg = 1 To Sheets.Count
        If Sheets(fg).Name <> "Risultati" Then
            For y = 2 To Sheets(fg).Cells(Rows.Count, 1).End(xlUp).Row
                For x = 1 To Sheets(fg).Cells(1, Columns.Count).End(xlToLeft).Column
                    If Sheets(fg).Cells(y, x) Like "*" & ricerca & "*" Then
                        uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                        Sheets(fg).Cells(y, x).EntireRow.Copy
                        Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                    End If
                Next x
            Next y
        End If
    Next fg
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Fai attenzione però che con l'operatore "Like" così come lo hai scritto trovi tutte le righe che contengono la parte ricercata.
E' perfetta, ti ringrazio tantissimo, ti chiedo solo una cortesia se possibile. si potrebbe inserire in una colonna il nome del foglio da cui provengono le righe? la colonna puo' essere la R
Sarebbe il top!!!
Grazie Mille
 

small31

Utente junior
27 Febbraio 2018
22
1
roma
2010
0
e' perfetta. ora avrei la necessità di selezionare dopo un filtro le celle visibili per poterle tagliare e incollare su altro foglio
non serve più ho risolto cosi:

Codice:
Private Sub CommandButton1_Click()
Dim ur As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
Dim r, c, x
ur = Worksheets("RDA").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Worksheets("RDA").Range("H2:H" & ur)
For Each cel In rng
lr = Worksheets("KIT").Cells(Rows.Count, 1).End(xlUp).Row
    If cel.Value <> 0 Then
        Worksheets("KIT").Cells(lr + 1, 1).Value = cel.Offset(0, -7).Value
        Worksheets("KIT").Cells(lr + 1, 2).Value = cel.Offset(0, -6).Value
        Worksheets("KIT").Cells(lr + 1, 3).Value = cel.Offset(0, -4).Value
        Worksheets("KIT").Cells(lr + 1, 4).Value = cel.Offset(0, -3).Value
        Worksheets("KIT").Cells(lr + 1, 5).Value = cel.Offset(0, -2).Value
        Worksheets("KIT").Cells(lr + 1, 6).Value = cel.Offset(0, -1).Value
        Worksheets("KIT").Cells(lr + 1, 10).Value = cel.Offset(0, 10).Value
        Worksheets("KIT").Cells(lr + 1, 6).Value = cel.Value
    End If
Next cel


r = Cells(Rows.Count, 8).End(xlUp).Row
For x = r To 2 Step -1
    If Cells(x, 8) > 0 Then
        Rows(x & ":" & x).Select
        Selection.Delete Shift:=xlUp
    End If
Next x
End Sub
 
Ultima modifica di un moderatore:

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!