Trovare un dato su tutti i fogli di Excel con l'indicazione del foglio su cui è scritto il dato trovato

Anonimo
2015-02-05T18:58:17+00:00

Buona sera a tutti, ho creato una Userform con una Textbox dove inserisco il dato da trovare ed un pulsante di comando che lancia il codice per la ricerca del dato sul foglio attivo.

Il mio File contiene 12 fogli per quanti sono i mesi dell'anno ( chiamati ognuno per il mese corrispondente es. gennaio, febbraio e cosi via fino a dicembre), i fogli contengono tutti la stessa struttura e nr. di colonne.

I dati di ogni singolo foglio  indicano un certo numero di dipendenti che pago nel mese di riferimento.

Ho la necessità di creare un codice che mi trovi il dato inserito nella Textbox agendo su tutti i fogli ( ora per fare ciò sono costretto a selzionare ogni singolo foglio e cercare il dato inserito).

I dati che inserisco per la ricerca sono solo due poiché gli altri non mi interessano e sono o Matricola o Cognome  e Nome.

Se Effettuo la ricerca per Matricola ( es. 888555W,965321A  - sempre 6 numeri e lettera finale)il codice no ha difficoltà a trovare un duplicato poiché e un codice univoco.

Se effettuo la ricerca per Cognome  e Nome invece, poiché ci sono tanti omonimi il codice dovrebbe segnalarmi (Tipo quanto si fa con Debug Print) quanti dipendenti mi trova con quel Cognome e Nome aggiungendomi  a fianco anche  la Matricola per meglio inquadrare il dipendente che mi interessa.

Il codice dovrebbe, inoltre  indicarmi il foglio su cui è scritto il dato trovato.

Le prime tre colonne di ogni foglio di lavoro hanno questi dati:

Nr.Progressivo   Matricola              Cognome e Nome

1                         888555W              CICCIO PUCCI

2                         965321A                SOLE LUCE

3                         5461323S              BIANCHI BLU

Chiedo il vostro aiuto  e la vostra competenza per quanto richiedo.

Spero di essere stato chiaro, diversamente Vi prego di volermi chiedere altro.

Ciao, Nicola.

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti Nessun commento

Risposta accettata dall'autore della domanda

Anonimo
2015-02-07T04:08:25+00:00

Ciao Nicola,

Ciao Normann, se ti è possibile, ti chiedo la cortesia di poter visualizzare nella listbox le intestazioni di colonna in corrispondenza dei dati trovati es:

Nr. Progressivo  Matricola  Cognome e Nome

E' possibile inoltre selezionare il dato nella listbox e aprire il contestuale foglio di lavoro su cui è posizionato il dato che seleziono.

Questo mi faciliterebbe moltissimo il lavoro e cioè non aprire manualmente il foglio di lavoro dopo aver annotato prima (o a memoria oppure su una carta) il dato trovato memorizzando anche il foglio.

Chiedo scusa per il ritardo con cui ti rispondo ma sono stato molto impegnato altrove.

Prova quanto segue: -

Crea una Userform con una Label (Label1), una TextBox (TextBox1), una ListBox (ListBox1) e due CommandButton (CommandButton1CommandButton2 ). Non preoccuparti per le dimensioni, la posizione o le altre proprietà di questi oggetti!

· Alt-F11 per aprire l'editor di VBA

· Alt-IM per inserire un nuovo modulo di codice

Nel nuovo modulo vuoto, incolla il seguente codice:

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

Option Explicit

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

Public Sub ApriUserform()

    UserForm1.Show False

End Sub

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

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

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

Public Sub RenameSheetsAsMonths()

   Dim WB As Workbook

    Dim ArrMese As Variant

    Dim i As Long

    Set WB = ActiveWorkbook

    ArrMese = Application.GetCustomListContents(4)

    On Error Resume Next

    For i = 1 To 12

        WB.Sheets(i).Name = ArrMese(i)

    Next i

    On Error GoTo 0

End Sub

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

Nel modulo della Userform, incolla il seguente codice:

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

Option Explicit

Dim WB As Workbook

Dim tempSH As Worksheet

Const sName As String = "TempData"

Private Sub ListBox1_Click()

    Dim i As Long

    Dim SH As Worksheet

    Dim destRng As Range

    On Error Resume Next

    With Me.ListBox1

        Set SH = WB.Sheets(.List(.ListIndex, 3))

        Set destRng = SH.Range("A" & .List(.ListIndex, 4)).Resize(1, 3)

        Application.Goto destRng

    End With

    On Error GoTo 0

End Sub

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

Private Sub UserForm_Initialize()

    With Me

        .Caption = "Estra & Trova Record"

        .BackColor = &HC0E0FF

        .Height = 190

        .Width = 288.75

        With .ListBox1

            .ColumnCount = 5

            .ColumnWidths = "37;48;90;45;22"

            .ColumnHeads = True

            .BackColor = &HC0FFFF

            .Left = 18

            .Top = 54

            .Height = 72

            .Width = 247.5

        End With

        With .CommandButton1

            .ForeColor = &H8000&

            .Font.Bold = True

            .Caption = "Estrarre Record"

            .Width = 80

            .Left = 115.5

            .Top = 142.5

        End With

        With .CommandButton2

            .Caption = "Esci"

            .Width = 40

            .ForeColor = vbRed

            .Font.Bold = True

            .Left = 229.5

            .Top = 142.5

        End With

        With Me.TextBox1

            .ForeColor = vbRed

            .BackColor = &HC0FFFF

            .Font.Bold = True

            .Left = 18

            .Top = 27

        End With

        With .Label1

            .Width = 144

            .Caption = "Matricola o Nome & Cognome"

            .BackColor = &HC0E0FF

            .ForeColor = vbBlue

            .Font.Bold = True

            .Left = 6

            .Top = 12

        End With

    End With

    On Error Resume Next

    Set WB = ThisWorkbook

    With WB

        Set tempSH = .Sheets("TempData")

        If Not tempSH Is Nothing Then

            tempSH.Cells.ClearContents

        Else

            Set tempSH = .Sheets.Add

            With tempSH

                .Name = sName

                .Visible = xlSheetVeryHidden

            End With

        End If

    End With

    On Error GoTo 0

End Sub

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

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode = 0 Then

        Call CommandButton2_Click

    End If

End Sub

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

Private Sub CommandButton1_Click()

    Dim arrFogli As Variant

    Dim arrIn As Variant, arrOut() As Variant

    Dim SH As Worksheet

    Dim Rng As Range, destRng As Range

    Dim arrIntestazioni As Variant

    Dim i As Long, j As Long, k As Long

    Dim LRow As Long, iCol As Long

    Dim sStr As String, aStr As String

    Dim Res As Variant

    Dim blMatricola As Boolean, blNome As Boolean

    Const sIntestazioni As String = "Nr.Progressivo,Matricola," _

                                     & "Cognome e Nome,Foglio,Riga"

    ActiveCell.Select

    arrIntestazioni = Split(sIntestazioni, ",")

    sStr = UCase(Me.TextBox1.Value)

    If sStr Like "??????[A-Z]" Then

        blMatricola = True

        iCol = 2

        aStr = "La Matricola "

    ElseIf sStr = vbNullString Then

        Exit Sub

    Else

        blNome = True

        iCol = 3

        aStr = "Il Nome & Cognome "

    End If

    arrFogli = Application.GetCustomListContents(4)

    ReDim Preserve arrOut(1 To 5, 1 To 1)

    For k = LBound(arrIntestazioni) To UBound(arrIntestazioni)

        arrOut(k + 1, 1) = arrIntestazioni(k)

    Next k

    j = 1

    For Each SH In WB.Worksheets

        With SH

            Res = Application.Match(SH.Name, arrFogli, 0)

            If Not IsError(Res) Then

                LRow = .Cells(Rows.Count, "B").End(xlUp).Row

                Set Rng = .Range("A2:C" & LRow)

                arrIn = Rng.Value

                For i = 1 To LRow - 1

                    If UCase(arrIn(i, iCol)) = sStr Then

                        j = j + 1

                        ReDim Preserve arrOut(1 To 5, 1 To j)

                        For k = 1 To 3

                            arrOut(k, j) = arrIn(i, k)

                        Next k

                        arrOut(4, j) = .Name

                        arrOut(5, j) = i + 1

                    End If

                Next i

            End If

        End With

    Next SH

    If j > 1 Then

        With tempSH

            .Cells.ClearContents

            Set destRng = .Range("A1").Resize(j, 5)

            destRng.Value = Application.Transpose(arrOut)

            Me.ListBox1.RowSource = _

                .Range("A2").Resize(j - 1, 5).Address(External:=True)

        End With

    Else

        Call MsgBox(Prompt:=aStr & sStr & " non e' stato trovato!", _

                    Buttons:=vbInformation, _

                    Title:="NON TOVATO!")

    End If

End Sub

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

Private Sub TextBox1_AfterUpdate()

    Me.CommandButton1.SetFocus

End Sub

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

Private Sub CommandButton2_Click()

    tempSH.Cells.ClearContents

    Unload Me

End Sub

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

Potresti scaricare il mio file di prova (NicolaV2_20150206) a:  http://1drv.ms/1ADNA5q

Quando apri il mio file, vedrai che ho aggiunto un pulsante del tipo Forms (non ActiveX) e ho assegnato il pulsante alla macro ApriUserform. Se utilizzi questo pulsante per aprire la Userform, sarai in grado di navigare in tutta la cartella di lavoro anche quando la Userform è aperta.

===

Regards,

Norman

La risposta è stata utile?

0 commenti Nessun commento

Risposta accettata dall'autore della domanda

Anonimo
2015-02-06T13:25:08+00:00

Ciao Nicola,

Oltre ai suggerimenti di Alessandra, prova qulalcosa del genere.

Crea una Userform con una TextBox (TextBox1), una ListBox (ListBox1) e due CommandButton (CommandButton1 e CommandButton2).

Nel modulo di codice della Userform, incolla il seguente codice:

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

Option Explicit

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

Private Sub UserForm_Initialize()

    With Me

        With .ListBox1

            .ColumnCount = 4

            .ColumnWidths = "20;50;80;40"

        End With

        With .CommandButton1

            .Caption = "Estrarre Record"

            .Width = 80

        End With

        With .CommandButton2

            .Caption = "Esci"

            .Width = 40

            .ForeColor = vbRed

        End With

    End With

End Sub

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

Private Sub CommandButton1_Click()

    Dim arrFogli As Variant

    Dim arrIn As Variant, arrOut() As Variant

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range

    Dim i As Long, j As Long, k As Long

    Dim LRow As Long, iCol As Long

    Dim sStr As String, aStr As String

    Dim Res As Variant

    Dim blMatricola As Boolean, blNome As Boolean

    Set WB = ThisWorkbook

    sStr = UCase(Me.TextBox1.Value)

    If sStr Like "??????[A-Z]" Then

        blMatricola = True

        iCol = 2

        aStr = "La Matricola "

    ElseIf sStr = vbNullString Then

        Exit Sub

    Else

        blNome = True

        iCol = 3

        aStr = "Il Nome & Cognome "

    End If

    arrFogli = Application.GetCustomListContents(4)

    For Each SH In WB.Worksheets

        With SH

            Res = Application.Match(SH.Name, arrFogli, 0)

            If Not IsError(Res) Then

                LRow = .Cells(Rows.Count, "B").End(xlUp).Row

                Set Rng = .Range("A2:C" & LRow)

                arrIn = Rng.Value

                For i = 1 To LRow - 1

                    If UCase(arrIn(i, iCol)) = sStr Then

                        j = j + 1

                        ReDim Preserve arrOut(1 To 4, 1 To j)

                        For k = 1 To 3

                            arrOut(k, j) = arrIn(i, k)

                            arrOut(4, j) = .Name

                        Next k

                    End If

                Next i

            End If

        End With

    Next SH

    If CBool(j) Then

        Me.ListBox1.List = Application.Transpose(arrOut)

    Else

        Call MsgBox(Prompt:=aStr & sStr & " non e' stato trovato!", _

                    Buttons:=vbInformation, _

                    Title:="NON TOVATO!")

    End If

End Sub

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

Private Sub CommandButton2_Click()

    Unload Me

End Sub

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

In un modulo standard, incolla:

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

Option Explicit

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

Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

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

Per utilizzare questo codice, basta inserire una matricola o un nome/cognome nella TextBox1 e poi premere il CommandButton1.

===

Regards,

Norman

La risposta è stata utile?

0 commenti Nessun commento

19 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2015-02-06T12:31:41+00:00

    Buongiorno Alessandra, grazie innazitutto per il tuo cortese riscontro.

    Il controllo di ricerca del dato dovrebbe avvenire su tutti i fogli, basandosi solo sulle celle con i dati ( ho visto in intenet tipo UsedRange).

    Una volta individuato il dato dovrei essere avvisato (magari tramite Msgbox) del Foglio su cui è scritto il dato trovato, questo penso che sia semplice se il dato da trovare è la Matricola, poiche come dicevo con il post precedente: Se Effettuo la ricerca per Matricola ( es. 888555W,965321A  - sempre 6 numeri e lettera finale) il codice non ha difficoltà a trovare un duplicato poiché e un codice univoco.

    Mentre diventa piu complicato ( per me  ma non per voi esperti) quando il dato da ricercare è il Cognome e Nome ( ripeto su tutti i fogli), dato che ho tanti omonimi ed in questo caso il codice dovrebbe avvisarmi di aver trovato es. Nr.4 Pinco Pallino ed il messaggio dovrebbe riportare i dati come te li riporto di seguito:

    Pinco Pallino - Gennaio - 888555Z

    Pinco Pallino - Febbraio - 784512S

    Pinco Pallino - MARZO - 984512T

    Pinco Pallino - APRILE - 412365Q

    N.B.  GENNAIO, FEBBRAIO, MARZO, APRILE e cosi via sono i nomi dei fogli su cui deve agire il codice di ricerca del dato ( rinominati per tutti i mesi dell'anno).

    412365Q questa stringa alfanumerica invece indica la matricola del dipendente.

    Spero di essere stato chiaro.

    Ciao Nicola.

    P.S. chiedimi altro Alessandra, è più difficile per me spiegarvelo che per voi realizzare il codice che fa questo.

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2015-02-06T11:59:19+00:00

    Ma una volta che hai trovato il dato che ci fai?

    In ogni caso, devi fare un ciclo su tutti i fogli e guardare in tutte le celle della colonna che ti interessa

    fai un ciclo tipo questo

    Dim foglio As Worksheet

    Dim cella As Range

    Dim fogli As String

    Dim ValDaCercare As String

    ValDaCercare = TextBox.text <<< scrivi qui il valore preso dalla tua casella di testo

    For Each foglio In ActiveWorkbook.Worksheets

     For Each cella In foglio.Range("A1:A20")

      If cella.Value = ValDaCercare Then

      << codice da eseguire ogni volta che trova il valore >>

      End If

    Next

    Next

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2015-02-06T09:56:06+00:00

    Buongiorno a tutti, avete la possibilità di riscontrare la mia richiesta di aiuto, per favore. 

    Non esitate a chiedermi ulteriori dettagli o altro per meglio specificare il mio obbiettivo.

    Grazie e buon lavoro.

    La risposta è stata utile?

    0 commenti Nessun commento