Completare righe di numeri

[ikwae]

Ciao a tutti ... ho una routine, già completa di macro, da velocizzare ... si tratta di scegliere dei numeri in archivio confrontarli con il tabellone e, se non sono presenti, accodandoli a partire da P4 ... Ho altre macro di questo genere avute con aiuti precedenti ma con "prese" diverse... l'aiuto che cerco è di velocizzare il più possibile la procedura che poi si riduce in una sola "sezione " quella del confronto e nell'allegato descrivo le procedure che si eseguono... Ringraziando anticipatamente tutti coloro che mi possono aiutare 73 ikwae

http://www.filedropper.com/zmodellomasaiutorete

[Anthony47]

A cercare di capire il quesito mi si e' grippato il neurone destro...

Qui la tua descrizione, con IN MAIUSCOLO e tra parentesi quadre [ ] i miei dubbi e interrogativi:

Cerco aiuto a velocizzare questa routin con le seguanti fasi:
1) Genera un numero casuale in P3 e che non sia presente sul tabellone
[QUALI RESTRIZIONI CI SONO PER QUESTO RANDOM? 121 PUO' ANDARE BENE? NUMERI RIPETUTI VANNO BENE?]
[L'AREA P3:Sx E' PARZIALMENTE OCCUPATA; CHE FINE FANNO I NUMERI PRESENTI?]

2) Copia dall'Archivio I4:M(end) i quattrio numeri, sulla stessa riga, del numero casuale e li scrive a partire da X2
[CIOE' COPIO QUALE RIGA DI QUESTE COLONNE? PERCHE' DICI I4:M(END) SE L'ELENCO PARTE DA RIGA 3?]
[L'AREA X:AA AL MOMENTO E' OCCUPATA; CHE FINE FANNO I DATI ORA PRESENTI?]

3)mette il range X2:AA(end) in ordine Descescente(dal più alto al più basso "comanda" la Colonna AA
[QUESTO MI FAREBBE PENSARE CHE (VEDI PUNTO 2) I DATI RIMANGONO, E' LA SINGOLA RIGA CHE VIENE RIMPIAZZATA DAI DATI PRESI DA I:M...]

4) Confronta le quartine in X2:AA2 con i numeri presenti sul tabellone
[QUALE E' IL "TABELLONE" DI CUI PARLI?]
[DO' PER SCONTATO CHE I "PUNTI" SUCCESSIVI SIANO 4a, 4b E 4c]
3a) [COMINCIO DA X2:AA2, E] se almeno uno è presente sul tabellone scarta la quartina e va alla quartina successiva(sotto)[PASSO A X3:AA3]
3b) se non è presente nessun numero dei 4 numeri li scrive partendo da P4 [MA LA RIGA 3? RIMANE CON SOLO 1 NUMERO?]
3c) nel caso che non trova numeri per il tabellone [CIOE' DOPO AVER ESAMINATO FINO A X1141:AA1141?] ricomInciare dal punto 1 per continuare [CIOE' RIEMPIRE P4 CON UN NUMERO CASUALE?]

5)Ricomincia il giro dal punto 1 fintanto che non si riempiono le 18 righe [CIOE' RIEMPIRE P5 CON UN NUMERO CASUALE?]

Mi chiarisci le idee?
Ciao

[ikwae]

quote="Anthony47"]

QUALI RESTRIZIONI CI SONO PER QUESTO RANDOM? 121 PUO' ANDARE BENE? NUMERI RIPETUTI VANNO BENE?]
R) Genera un numero(compreso tra 1 e 90) casuale e lo scrive in P3 e che non sia presente sul range P3:T21

[L'AREA P3:Sx E' PARZIALMENTE OCCUPATA; CHE FINE FANNO I NUMERI PRESENTI?]
R sono dei numeri che servono alla routine di nessuna importanza da non considerare


[CIOE' COPIO QUALE RIGA DI QUESTE COLONNE? PERCHE' DICI I4:M(END) SE L'ELENCO PARTE DA RIGA 3?]
R in P3 si genera un numero casuale, ad esempio il 18, la macro deve scorrere tutto l'archivio,I3:M(end e non I4:M (end), errore di battitura e, trovare tutte le righe che c'è presente il 18 e scrivere i 4 numeri, di tutte le righe a partire X2.


[L'AREA X:AA AL MOMENTO E' OCCUPATA; CHE FINE FANNO I DATI ORA PRESENTI?]
sia cancellano da soli ogni volta che inizia la routine


3)mette il range X2:AA(end) in ordine Descescente(dal più alto al più basso "comanda" la Colonna AA
[QUESTO MI FAREBBE PENSARE CHE (VEDI PUNTO 2) I DATI RIMANGONO, E' LA SINGOLA RIGA CHE VIENE RIMPIAZZATA DAI DATI PRESI DA I:M...]
R la routine è predisposta che si prendono i dati dal'archivio come spiegato sopra di tutte le righe che contengono il numero 18 e riporta a partire da X2 tutti e 4 numeri presenti in ogni riga dell'archivio... quindi da X2 e per 4 colonne li mette in ordine decrescente e poi inizia il confronto di ogni riga (X2:AA2) con quelli del range P4:T21(tabellone) se anche un solo numero è presente sul tabellone scarta tutta la quartina e va a quella sotto fintanto che non trova tutti i 4 numeri non presenti sul tabellone quindi se non presenti sul tabellone li scrive a partire da P4 quindi la routine della prima riga è finita e parte la routine per la seconda riga cancellando l'aera sotto la X2:AA2 tutti i numeri sottostanti e si genera un altro numero casuale in P3(che non deve essere scritto da nessuna parte serve solo come riferimento per il prelievo dei 4 numeri presenti sulla stessa riga in archivio) ad esempio il numero 89 e la macro va in archivio e trova tutte le righe che contengono il numero 89 e li scrive a partire sotto a X2 e poi c'è il confronto ecc.. ecc..


nel caso che non trova numeri per il tabellone [CIOE' DOPO AVER ESAMINATO FINO A X1141:AA1141?] ricomInciare dal punto 1 per
continuare [CIOE' RIEMPIRE P4 CON UN NUMERO CASUALE?]
R se nel caso non ci sono numeri che si possono inserire sul tabellone la macro continua la prossima routine e quindi il buco mancante lo riempie la prossima routine ma lascia in fondo la 18 vuota che la riempie la splendida macro che mi hai fatto per completare i buchi vuoti e completare le 18 righe ]

Mi chiarisci le idee?
R Per riportare le domande e le risposte spero di non aver fatto dei pasticci o confuso maggiormente le idee ...

Naturalmente un grosso grazie per la risposta e l'aiuto che mi stai dando ... cordialmente 73 ikwae

[Anthony47]

Mi serve tempo...

[ikwae]

Gentilissimo Anthony... Grazie per il tempo che mi stai dedicando e aggiungo che l'aiuto che cerco si riduce in pochi passaggi ossia una volta letti i dati e sono sulle colonne X2:AA(end) si mettono in ordine decrescente("comanda" la colonna AA) e poi il confronto con il tabellone(range P4:T21) e cicla(qui è il nocciolo dell'aiuto che perde il 90% del tempo) fintanto che non trova 4 numeri che nessuno è presente sul tabellone e trovati i 4 numeri li scrive a partire dalla colonna P4 a dx ... la mia routine è funzionante e l'ho inserita solamente ad indicare la lentezza nel confronto a trovare i 4 numeri e non è ne da modificare ne quantomeno da riscriverla è solo per info ... In sostanza l'aiuto si riduce al confronto con il tabellone e scrivere i numeri a partire da P4....intanto attendo fiducioso come sempre .... cordialmente ikwae

[ikwae]

Gentilissimo Anthony ... grazie per la tua preziosa disponibilità .. Vediamo se con un supplemento di spiegazioni si riesce a capire dove mi trovo...
Ricominciando da zero, l'obiettivo è di riempire le 18 righe, con numeri da 1 al 90, sul tabellone(P4:T21) e, per fare questo uso un’unica macro che io ho suddiviso in tre blocchi per maggiore descrizione eccola...


'PRIMA PARTE CERCA I NUMERI E LI SCRIVE A PARTIRE DA X2(va bene e funge a meraviglia)

Codice: Seleziona tutto

Sub Cerca_Su_5C_4_Numeri()
Dim wArr, oArr(), lastC, I As Long, J As Long
Dim lFor As Integer, kO As Long, kV As Long, kJ As Long
Dim lDue As Integer, matCnt As Integer

 lastC = Cells(Rows.Count, 9).End(xlUp).Row
 wArr = Range("I3:M" & lastC).Value
 lFor = Range("P3").Value
 J = Application.WorksheetFunction.CountIf(Range("I3:M" & lastC), lFor)
 ReDim oArr(1 To J, 1 To 5)
For I = LBound(wArr) To UBound(wArr)
    If lDue > 0 Then matCnt = 0 Else matCnt = 1
     For J = 1 To 5
        If wArr(I, J) = lFor Or wArr(I, J) = lDue Then
            matCnt = matCnt + 1
        End If
        If matCnt = 2 Then
            kO = kO + 1: kJ = 0
                For kV = 1 To 5
                    If wArr(I, kV) <> lFor And wArr(I, kV) <> lDue Then
                        kJ = kJ + 1
                        oArr(kO, kJ) = wArr(I, kV)
                    End If
                Next kV
            Exit For
        End If
    Next J
Next I
Range("X:AA").ClearContents
Range("X2").Resize(UBound(oArr, 1), 4) = oArr

Questa prima parte è una macro di un precedente aiuto è funzionante ed è anche veloce va a cercare il numero scritto in P3 nelle righe dell’archivio e trovato il numero prende i 4 numeri associati(sulla stessa riga) e li scrive tutti a partire da X2:AA(end)...


'SECONDA PARTE METTE IN ORDINE DECRESCENTE LE COLONNE X2:AA(end) va bene e funge una meraviglia

Codice: Seleziona tutto

Range("X2:AA10000").Select
    ActiveWorkbook.Worksheets("Sviluppo").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sviluppo").Sort.SortFields.Add Key:=Range( _
        "AA2:AA10000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sviluppo").Sort
        .SetRange Range("X2:AA10000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.Panes(1).Activate
    Range("AC2").Select

Questa è una macro registrata con il registratore di macro e mette il range X2:AA(end) in ordine decrescente... anche questa non è da velocizzare


'TERZA PARTE CONFRONTO E SCRITTURA DEI NUMERI SUL TABELLONE(P4:T21) è la parte da modificare per velocizzarla il più possibile.

Codice: Seleziona tutto

Dim area As Range
10
If Range("AA2").Value = "" Then Exit Sub’se non ci sono dati in AA2 esci dalla macro
Dim X As Object 'Integer
Set area = Range("P4:T21")

For Each X In area
If X.Value = Range("X2").Value _
Or X.Value = Range("Y2").Value _
Or X.Value = Range("Z2").Value _
Or X.Value = Range("AA2").Value Then GoTo 20
Next

Range("X2:AA2").Copy
'Posizione dove incollare i dati
Dim iRow As Integer
iRow = 4 'riga
While Cells(iRow, 16).Value <> "" '16 la P
iRow = iRow + 1
Wend
Cells(iRow, 16).Select 'wae impila in P4
'ActiveSheet.Paste
'wae solo valori altrimenti cancella la FC
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
Application.CutCopyMode = True

GoTo 30

20
  Range("X2:AA2").Select
  Selection.Delete Shift:=xlUp
  Range("V2").Select
GoTo 10
30
Range("V2").Select
Set area = Nothing
End Sub


Questa è la parte interessata che è molto lenta ed è da velocizzare il più possibile ... questa macro “casareccia” funziona e porta a termine il suo lavoro ma è lenta quindi questa macro ha la funzione di confrontare i 4 numeri per volta X2:AA2 con tutti quelli del tabellone(P4:T21)

a) se c’è anche un solo numero presente sul tabellone “scarta” tutta la quartina tira su le 4 celle e continua a confrontare un’altra fintanto che ci sono dati in AA2 ... se non ci sono dati in AA2 perché finiscono lascia il buco che verrà riempito con il prossimo confronto ... se rimane un buco in fondo(la 17 o la 18à riga) lo riempie un’altra macro di un tuo precedente aiuto di nome [Sub Filler(ByVal tArea As String)].
b) se tutti i 4 numeri non sono presenti sul tabellone(P4:T21) scrive i 4 numeri a patire da P4...

Spero di aver dato ulteriori spiegazioni al completamento dell’aiuto ... non finirò mai di ringraziarti per il tuo tempo che mi dedichi ... Cordialmente ikwae

[Anthony47]

Allora, credo che le ultime indicazioni fornite mi abbiano fatto capire cosa intendevi.

Se e' come l'ho capita, allora:
1) Aboliamo la Sub Giro_MAS_ModelloUnico (il fatto che sia lei a richiamare la Sub Cerca_Su_5C_4_Numeri e' motivo di inefficienza), e spostiamo nella Sub Cerca_Su_5C_4_Numeri la pulizia del tabellino P4:T21, la creazione del numero random, e (in coda) l'inserimento degli eventuali mancanti.
2) Inseriamo un codice che usi un algoritmo piu' semplice e piu' efficiente di quello che hai usato, per la ricerca della quartina da inserire sulla tabellina in P4:S21
3) Ripristiniamo il codice di riempimento e ne approfitto per renderlo un pelino piu' efficiente; vedi Sub Filler2
4) Giacche' ci siamo modifichiamo la sub che genera il numero random: vedi Sub GeneraTestimone2

Il codice complessivo nuovo:

Codice: Seleziona tutto

Sub Cerca_Su_5C_4_Numeri()
Dim wArr, oArr(), lastC, I As Long, J As Long
Dim lFor As Integer, kO As Long, kV As Long, kJ As Long
Dim lDue As Integer, matCnt As Integer
Dim nArr(1 To 90), cCell As Range, noBBLine As Boolean, IiI As Long
'

'Application.ScreenUpdating = False

'mytim = Timer remmato wae
'--------------------------------
'lastC = Cells(Rows.Count, 3).End(xlUp).Row
lastC = Cells(Rows.Count, 9).End(xlUp).Row 'wae colonna I
'--------------------------------
'wArr = Range("C3:G" & lastC).Value
 wArr = Range("I3:M" & lastC).Value
 
 lFor = Range("P3").Value
'lDue = Range("Q3").Value 'wae

'------------------------------------------------
'j = Application.WorksheetFunction.CountIf(Range("C3:G" & lastC), lFor)
 J = Application.WorksheetFunction.CountIf(Range("I3:M" & lastC), lFor)

'-------------------------------
'ReDim oArr(1 To j, 1 To 4)
 ReDim oArr(1 To J, 1 To 5)
'PULIZIA "Tabellino":
Range("P4").Resize(18, 5).ClearContents
'NUOVO LOOP (ma P3 quando si compila?):
For IiI = 1 To 18
    GeneraTestimone2
    kO = 0: kJ = 0: kV = 0: matCnt = 0      'Variabili da AZZERARE
    For I = LBound(wArr) To UBound(wArr)
    'If I > 6230 Then Stop           '6236
        If lDue > 0 Then matCnt = 0 Else matCnt = 1

        '------------------
        'For j = 1 To 4
         For J = 1 To 5
            If wArr(I, J) = lFor Or wArr(I, J) = lDue Then
                matCnt = matCnt + 1
            End If
            If matCnt = 2 Then
                kO = kO + 1: kJ = 0
                    For kV = 1 To 5
                        If wArr(I, kV) <> lFor And wArr(I, kV) <> lDue Then
                            kJ = kJ + 1
                            oArr(kO, kJ) = wArr(I, kV)
                        End If
                    Next kV
                Exit For
            End If
        Next J
    Next I
    Range("X:AA").ClearContents
    '''Range("X2").Resize(UBound(oArr, 1), 4) = bbNDecSort(oArr, 4)
    Range("X2").Resize(UBound(oArr, 1), 4) = oArr
    '|----------------------------------------------------------------------------
    'wae metodo lento
    'wae colonne X:AA dal più grande comanda Colonna AA
       Range("X2:AA10000").Select
        ActiveWorkbook.Worksheets("Sviluppo").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sviluppo").Sort.SortFields.Add Key:=Range( _
            "AA2:AA10000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Sviluppo").Sort
            .SetRange Range("X2:AA10000")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ActiveWindow.Panes(1).Activate
        Range("AC2").Select
    'MsgBox ("Completato, Sec: " & Format(Timer - mytim, "0.00"))
    'End Sub
    '|----------------------------------------------------------------------------
   
'Cerca in X:AA la prima riga buona...
    oArr = Range("X2").Resize(UBound(oArr, 1), 4).Value
    Erase nArr
    'Compila Array numeri usati:
    For Each cCell In Range("P4:S21")
        If cCell.Value = "" Then Exit For
        nArr(cCell.Value) = 1
    Next cCell
    'Loop in oArr:
    For I = 1 To UBound(oArr)
        noBBLine = False
        For J = 1 To 4
        'check se anche 1 solo num gia' presente:
            If nArr(oArr(I, J)) > 0 Then
                noBBLine = True
                Exit For
            End If
        Next J
        If noBBLine = False Then Exit For   'Riga non buona
    Next I
    'Trovata la riga, la posiziona in Tabellino:
    If noBBLine = False Then
        For J = 1 To 4
            Cells(3 + IiI, 15 + J) = oArr(I, J)
        Next J
    End If
Next IiI
Call Filler2("P4:S21")        '????
End Sub


Sub GeneraTestimone2()
Dim I As Integer
Dim J As Integer
Dim Estratto As Integer
'Dim Riga As Integer
Dim area As Range
'
If Range("P22").Value <> "" Then Exit Sub
Do
    Randomize
    Estratto = Int(Rnd() * 90) + 1
    If Application.WorksheetFunction.CountIf(Range("P4:T20"), Estratto) = 0 Then Exit Do
Loop
Range("P3") = Estratto
End Sub


Sub Filler2(ByVal tArea As String)
Dim nArr(1 To 90), myC As Range
Dim I As Long, Miss As Long, myRan As Long
'
For I = 1 To 90
    nArr(I) = I
Next I
Miss = Application.WorksheetFunction.CountBlank(Range(tArea))
If Miss > 0 Then
    For Each myC In Range(tArea)
        If myC.Value <> "" Then nArr(myC.Value) = 0
    Next myC
    For Each myC In Range(tArea)
        If myC.Value = "" Then
            myRan = Int(Miss * Rnd()) + 1
            myC.Value = Application.WorksheetFunction.Large(nArr, myRan)
            nArr(myC.Value) = 0
            Miss = Miss - 1
        End If
    Next myC
End If
End Sub


La Sub Giro_MAS_ModelloUnico, le Sub Filler e la Sub GeneraTestimone sono superate e possono essere rimosse.

Ho un dubbio su quale sia l'area da riempire, vedi istruzione marcata ???
-deve essere P4:S21 (visto che si lavora su 4 colonne) o P4:T21?

Come pure non ho inserito nel nuovo codice la gestione della cella O3, di cui ignoro il significato.

Ciao

[ikwae]

Gentilissimo Anthony ...

Ho un dubbio su quale sia l'area da riempire, vedi istruzione marcata ???
-deve essere P4:S21 (visto che si lavora su 4 colonne) o P4:T21?

Codice: Seleziona tutto

'modificato per avere tutte le righe complete da
 Call Filler2("P4:S21")        '????
a
Call Filler2("P4:T21")       


pure non ho inserito nel nuovo codice la gestione della cella O3, di cui ignoro il significato.

Da non considerare nella macro, la macro va benissimo così la spiegazione è solo per info quindi non considerare!!...

La cella O3 indica quanti cicli in cicli completi vede fare la routine mentre la R3 indica i cicli parziali che deve compiere...
Mi spiego meglio in R3 metto 3 quindi fa 3 cicli da 18 righe = (3x18) 54 righe .... se in O3 metto 4 fa 4 volte il giro di R3 (54x4= 216 righe)...
Un esempio io inserisco normalmente in O3=12 e in R3=3 quindi faccio 648 righe ogni volta[(18x3)4]
...quindi si capisce perché era lento...


Adesso la macro corre in centesimi di secondi ossia la prima è istantanea e si vedono solo le righe complete mentre se si clicca più volte
la macro diventa un pelino più lenta e si vedono righe formarsi ma si parla di centesimi di secondi meno di un secondo, almeno sul mio pc...

Vorrei modificare la macro, tenendo tutte le procedure che ci sono, anziché prendere 4 numeri dall’archivio a 5 colonne, prenda tre numeri dall’archivio a 5 colonne e segue lo stesso procedimento dei 4 numeri ma con tre numeri quali sono le righe di codice da modificare?

Che dire uno spettacolo eclatante non ci sono parole questo sito e in particolare questa sezione del Forum e chi la lascia? Ormai mi dovete tenere a vita !!!! dovete capire se è una “minaccia” oppure un complimento io opto per il secondo come credo dai post letti che unanime la consapevolezza di essere al posto giusto nel momento giusto altre parole non servono....

@ raimea
non mi sono dimenticato di te questo è il 90% del programma che ti avevo promesso e di metterlo a disposizione di tutti(o solo chi è interessato) manca solo l’archivio a 4 colonne che è l’aiuto che la prossima volta posterò per l’aiuto sul Forum... ciao

nel ringraziare ulteriormente per la gradita ospitalità e del lavoro fatto cordialmente ikwae ... rinnovo per il caffè ....

[raimea]

ciao
stai sereno , io non ho nessuna fretta
e buon lavoro
ciao