Excel Forum Per condividere esperienze su Microsoft Excel

Estrazione casuale righe tabella excel

  • Messaggi
  • OFFLINE
    blusky974
    Post: 1
    Registrato il: 04/10/2012
    Città: ORISTANO
    Età: 49
    Utente Junior
    2010
    00 26/06/2017 10:38
    Buongiorno,

    ho una cartella con sette fogli.
    In ogni foglio sono presenti 8 colonne e un numero variabile di righe.
    Vorrei riuscire ad estrarre in maniera casuale 100 righe, senza ripetizioni, da queste tabelle.
    il risultato dovrebbe poi andare a finire in un nuovo foglio di lavoro.
    Mi date una mano??

  • OFFLINE
    dodo47
    Post: 1.427
    Registrato il: 06/04/2013
    Utente Veteran
    2010
    00 26/06/2017 18:26
    Ciao
    Casuali per foglio spero, cioè per esempio la riga 15 si può ripetere nel foglio1 e nel foglio2 ecc.

    Se è così, nel tuo documento aggiungi un foglio chiamato ElencoRighe che sarà il foglio di destinazione delle righe estratte.

    Nota: se le righe sono molte la macro ci mette un bel po'. Intanto per testarla usala su un documento con 3/4 fogli e non più di 500 righe per foglio.

    Saluti

    Sub CasualiUnivoci() '<<<<<<<<<< da eseguire
    Dim N As Long, Ur As Long, Rand As Long, i As Long, UrTo As Integer, k As Worksheet
    Set wk = Worksheets("ElencoRighe")
    wk.Cells.ClearContents
    c = 1
    For j = 1 To Sheets.Count
        UrTo = 0
        If Sheets(j).Name <> "ElencoRighe" Then
            'ipotizzando che la col. A di ciascun foglio possa essere presa _
             per il conteggio massimo delle righe del foglio :
            Ur = Sheets(j).Range("A" & Rows.Count).End(xlUp).Row
            If Ur > 100 Then UrTo = 100 Else UrTo = Ur
            If Ur > 1 Then
                ReDim Unique(1 To Ur, 1 To 1)
                For i = 1 To Ur
                    Randomize
                    Do
                        Rand = Int(Ur * Rnd) + 1 'nota: + 1 per evitare che esca la riga 0 (zero)
                        If IsUnique(Rand, Unique) Then Unique(i, 1) = Rand:  Exit Do
                    Loop
                Next
            End If
        End If
        If Sheets(j).Name <> "ElencoRighe" Then
            wk.Cells(1, c) = Sheets(j).Name
            For i = 1 To UrTo
                Cells(i + 1, c) = Unique(i, 1)
            Next i
            c = c + 1
        End If
    Next j
    End Sub
    
    Function IsUnique(Num As Long, Data As Variant) As Boolean
    Dim iFind As Long
    On Error GoTo Unico
    iFind = Application.WorksheetFunction.Match(Num, Data, 0)
    If iFind > 0 Then IsUnique = False: Exit Function
    Unico:
    IsUnique = True
    End Function



    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    blusky974
    Post: 1
    Registrato il: 04/10/2012
    Città: ORISTANO
    Età: 49
    Utente Junior
    2010
    00 26/06/2017 18:45
    Grazie Domenico, ma non funziona, o forse sbaglio qualcosa...

    in pratica nel foglio di output dovrebbero comparire le righe degli altri fogli

    Carico un esempio
    [Modificato da blusky974 26/06/2017 18:49]
  • OFFLINE
    dodo47
    Post: 1.428
    Registrato il: 06/04/2013
    Utente Veteran
    2010
    00 26/06/2017 19:04
    Ciao
    quello che io estraggo è il numero delle righe non il contenuto.
    Comunque quella è la base di partenza.

    Ciò premesso, a fine macro, al posto di stampare i numeri dei singoli fogli contenuti nell'array unique(), stampi le relative righe.

    A parte tutto questo, se fai una ricerca sul forum (quiz - mescolare quiz), trovi:
    http://www.freeforumzone.com/discussione.aspx?idd=11032986&t=636007407468165521

    un bellissimo lavoro di by sal.

    saluti

    Edit: indicazione su come stampare le righe dei fogli e non il numero.
    [Modificato da dodo47 27/06/2017 09:06]
    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    blusky974
    Post: 2
    Registrato il: 04/10/2012
    Città: ORISTANO
    Età: 49
    Utente Junior
    2010
    00 04/07/2017 09:03
    Grazie mille per l'aiuto!
    Ho visto il lavoro nella discussione che mi hai segnalato e ho risolto alla grande!