Condividi:        

Excel Trova ambo

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Excel Trova ambo

Postdi Statix » 15/06/10 23:56

Ciao a tutti,
dovrei con una macro,cercare con un ciclo i primi 10 ambi della cinquina Range("J2:N2")
in un archivio range("C4:G3000")
ciclo di partenza Range("P2") 10 to 1 step -1
in questo esempio ho evidenziato i primi 3 ambi
in giallo ciclo1 Range("P2") =1
in arancione ciclo2 Range("P2") =2
in verde ciclo3 Range("P2") =3
ad ogni ciclo la macro mi deve trascrivere i valori nel range("J5:N7")del Range delle celle sopra ,centro e sotto
il centro dove trova l'ambo
allego foto come esempio
i range J11:N13 e J15:N17 sono solo esempi di come deve trascrivere i dati ma sempre nel range("J5:N7")che ad ogni ciclo li copio in un altro foglio.
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Excel Trova ambo

Postdi Statix » 15/06/10 23:57

Dimenticavo gli ambi possono essere anche ripetuti,
l'importante che il ciclo mi conta i primi 10 partendo d'alto a scendere.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Anthony47 » 16/06/10 00:45

Una linea che contenesse un terno come lo devi contare, 1 o 3?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Trova ambo

Postdi Statix » 16/06/10 07:23

Ciao Anthony,
se in una linea c'è ne sono 3 o 4 deve essere contata sempre per 1,
quello che è importante, è che ad ogni ciclo i dati vengono trascritti nel range J5:N7 cosi come nell'esempio
la linea dell'ambo o del terno,la linea sopra e la linea sotto.
nel range P2, li dovrei mettere il valore del ciclo ad esempio il valore 10
il ciclo for next =10 to 1 step -1
se metto in P2= 15
il ciclo For Next = 15 to 1 step -1,
quindi la macro andrebbe a cercare per primo, l'ultimo ambo poi il penultimo e cosi via,
comunque può andare bene anche al contrario.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 16/06/10 21:04

Secondo me ci sono dei controsensi
l'8 e il 5 non sono allineati alla riga 5 dell'estrazione ma sono sulla riga 6
mentre troviamo l'8 e il 38 alla riga 12 (sia estrazione che risultato)
ma se quell'8 e 38 fossero usciti all'estrazione del 5 giugno (riga 6), come si dovrebbe procedere con i dati che si "accavallano"?
Non è forse meglio evitare di riportare i dati allineati all'estrazione ma uno di seguito all'altro (sempre inserendo l'estrazione precedente e qulla successiva)?

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Statix » 16/06/10 21:29

Ciao Flash30005,
l'allineamento dei dati non conta,
i 2 range J11:N13 e J15:N17 li ho messi come esempio,
la macro non deve altro che trovare il primo ambo del range J2:N2 ,nel range C4:G1000
per la prima occorrenza e trascrivere la riga sopra,quella centrale(ambo o terno che sia) e la linea sotto
come in J5:N7,un altra macro prende questi dati e li memorizza in un altro foglio.
dopo la macro passa alla seconda occorrenza trova l'ambo e trascrive (sovrascrive)sempre nel range J5:N7
i dati come ( J11:N13 li ho messi per farvi l'esempio i dati che trova alla seconda occorrenza)
e poi passa alla terza occorrenza,
il ciclo sarà dato dal valore in P2 =10
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 17/06/10 00:44

Facciamo un tentativo...

Codice: Seleziona tutto
Sub TrovaAmbi()
UR = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
Dim VNR(5) As String
Dim VNE(5) As String
Dim AN(10) As String
Dim AE(10) As String
VCD = Range("P2").Value
MVCD = VCD
Range("J2:N2").Interior.ColorIndex = xlNone
Range("C4:G" & UR).Interior.ColorIndex = xlNone
VNR(1) = Format(Cells(2, 10).Value, "00")
VNR(2) = Format(Cells(2, 11).Value, "00")
VNR(3) = Format(Cells(2, 12).Value, "00")
VNR(4) = Format(Cells(2, 13).Value, "00")
VNR(5) = Format(Cells(2, 14).Value, "00")

AN(1) = VNR(1) & VNR(2)
AN(2) = VNR(1) & VNR(3)
AN(3) = VNR(1) & VNR(4)
AN(4) = VNR(1) & VNR(5)
AN(5) = VNR(2) & VNR(3)
AN(6) = VNR(2) & VNR(4)
AN(7) = VNR(2) & VNR(5)
AN(8) = VNR(3) & VNR(4)
AN(9) = VNR(3) & VNR(5)
AN(10) = VNR(4) & VNR(5)
If Val(VNR(1)) > Val(VNR(2)) Then AN(1) = VNR(2) & VNR(1)
If Val(VNR(1)) > Val(VNR(3)) Then AN(2) = VNR(3) & VNR(1)
If Val(VNR(1)) > Val(VNR(4)) Then AN(3) = VNR(4) & VNR(1)
If Val(VNR(1)) > Val(VNR(5)) Then AN(4) = VNR(5) & VNR(1)
If Val(VNR(2)) > Val(VNR(3)) Then AN(5) = VNR(3) & VNR(2)
If Val(VNR(2)) > Val(VNR(4)) Then AN(6) = VNR(4) & VNR(2)
If Val(VNR(2)) > Val(VNR(5)) Then AN(7) = VNR(5) & VNR(2)
If Val(VNR(3)) > Val(VNR(4)) Then AN(8) = VNR(4) & VNR(3)
If Val(VNR(3)) > Val(VNR(5)) Then AN(9) = VNR(5) & VNR(3)
If Val(VNR(4)) > Val(VNR(5)) Then AN(10) = VNR(5) & VNR(4)

For CD = VCD To 1 Step -1
Conta = 0
For RRE = 4 To UR
VNE(1) = Format(Cells(RRE, 3).Value, "00")
VNE(2) = Format(Cells(RRE, 4).Value, "00")
VNE(3) = Format(Cells(RRE, 5).Value, "00")
VNE(4) = Format(Cells(RRE, 6).Value, "00")
VNE(5) = Format(Cells(RRE, 7).Value, "00")

AE(1) = VNE(1) & VNE(2)
AE(2) = VNE(1) & VNE(3)
AE(3) = VNE(1) & VNE(4)
AE(4) = VNE(1) & VNE(5)
AE(5) = VNE(2) & VNE(3)
AE(6) = VNE(2) & VNE(4)
AE(7) = VNE(2) & VNE(5)
AE(8) = VNE(3) & VNE(4)
AE(9) = VNE(3) & VNE(5)
AE(10) = VNE(4) & VNE(5)
If Val(VNE(1)) > Val(VNE(2)) Then AE(1) = VNE(2) & VNE(1)
If Val(VNE(1)) > Val(VNE(3)) Then AE(2) = VNE(3) & VNE(1)
If Val(VNE(1)) > Val(VNE(4)) Then AE(3) = VNE(4) & VNE(1)
If Val(VNE(1)) > Val(VNE(5)) Then AE(4) = VNE(5) & VNE(1)
If Val(VNE(2)) > Val(VNE(3)) Then AE(5) = VNE(3) & VNE(2)
If Val(VNE(2)) > Val(VNE(4)) Then AE(6) = VNE(4) & VNE(2)
If Val(VNE(2)) > Val(VNE(5)) Then AE(7) = VNE(5) & VNE(2)
If Val(VNE(3)) > Val(VNE(4)) Then AE(8) = VNE(4) & VNE(3)
If Val(VNE(3)) > Val(VNE(5)) Then AE(9) = VNE(5) & VNE(3)
If Val(VNE(4)) > Val(VNE(5)) Then AE(10) = VNE(5) & VNE(4)

For RN = 1 To 10
Select Case RN
Case 1 To 4
C1 = 1
C2 = RN + C1
Case 5 To 7
C1 = 2
C2 = RN - C1
Case 8 To 9
C1 = 3
C2 = RN - C1 - 1
Case 10
C1 = 4
C2 = 5
End Select
C1 = C1 + 9
C2 = C2 + 9
    For RA = 1 To 10
   
Select Case RA
Case 1 To 4
C3 = 1
C4 = RA + C3
Case 5 To 7
C3 = 2
C4 = RA - C3
Case 8 To 9
C3 = 3
C4 = RA - C3 - 1
Case 10
C3 = 4
C4 = 5
End Select
C3 = C3 + 2
C4 = C4 + 2
   
        If AE(RA) = AN(RN) Then
        Conta = Conta + 1
        If Conta = CD Then
            MsgBox "Trovato " & CD & "°"
            Cells(RRE, C3).Interior.ColorIndex = 6
            Cells(RRE, C4).Interior.ColorIndex = 6
            Range("C" & RRE - 1 & ":G" & RRE + 1).Copy Destination:=Range("J5")
            Cells(2, C1).Interior.ColorIndex = 6
            Cells(2, C2).Interior.ColorIndex = 6
            GoTo esci
            End If
        End If
    Next RA
Next RN
Next RRE
esci:
Next CD
Range("P2").Value = MVCD
End Sub


(state diventando sempre più complicati) :lol:

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Anthony47 » 17/06/10 02:29

E se non risolvi col suggerimento di Flash:
Codice: Seleziona tutto
Sub piStat()
For I = 0 To Cells(Rows.Count, 3).End(xlUp).Row
Range("C4:G4").Offset(I, 0).Select
CCount = 0
For Each Cella In Range("C4:G4").Offset(I, 0)
CCount = CCount + Application.WorksheetFunction.CountIf(Range("J2:N2"), Cella.Value)
If CCount >= 2 Then Exit For
Next Cella
If CCount >= 2 Then
    Range("C4:G4").Offset(I - 1, 0).Resize(3, 5).Copy Destination:=Range("J5").Offset(I, 0)  '<<<<
    Ambo = Ambo + 1
End If
If Ambo >= Range("P2").Value Then Exit For
Next I
End Sub

Le righe interessate vengono copiate accanto all' elenco principale, se vuoi copiarle sempre in J5 elimina nell' istruzione marcata <<< la componente ".offset(I,0)"

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Trova ambo

Postdi Statix » 17/06/10 08:04

Ciao Flash3005,ciao Anthony,
entrambe le macro svolgono bene il loro lavoro,ed entrambe sono veloci.
la macro di Flash ha quel tocco in più di evidenziare l'ambo,e di darmi un messaggio.ad ogni ambo trovato,
visto che in precedenza usavo delle formule per fare questo tipo lavoro ma per un solo numero,
se era possibile modificare questa/e macro anche per un solo numero ,
quindi mettendo un opzione tipo per estratto o per ambo,
se seleziono opzione per estratto mi prende solo il valore del Range J2
mentre se opzione per ambo mi prende il Range J2:N2
rimanendo invariato tutto il resto .
vi ringrazio entrambi,
siete bravissimi ;) ;) ;)
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 17/06/10 09:50

Ho pensato di aggiungere una macro appositamente realizzata per questo evento
Codice: Seleziona tutto
Sub Avvio()
If Range("P1").Value = "Ambo" Then
Call TrovaAmbi
Else
Call TrovaEstr
End If
End Sub
Sub TrovaEstr()
UR = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
Dim VNR(5) As String
Dim VNE(5) As String
Dim AN(10) As String
Dim AE(10) As String
VCD = Range("P2").Value
MVCD = VCD
Range("J2:N2").Interior.ColorIndex = xlNone
Range("C4:G" & UR).Interior.ColorIndex = xlNone
Range("J5:N7").Clear
AN(1) = Format(Cells(2, 10).Value, "00")
AN(2) = Format(Cells(2, 11).Value, "00")
AN(3) = Format(Cells(2, 12).Value, "00")
AN(4) = Format(Cells(2, 13).Value, "00")
AN(5) = Format(Cells(2, 14).Value, "00")

For CD = VCD To 1 Step -1
Conta = 0
For RRE = 4 To UR
AE(1) = Format(Cells(RRE, 3).Value, "00")
AE(2) = Format(Cells(RRE, 4).Value, "00")
AE(3) = Format(Cells(RRE, 5).Value, "00")
AE(4) = Format(Cells(RRE, 6).Value, "00")
AE(5) = Format(Cells(RRE, 7).Value, "00")

For RN = 1 To 5
C1 = RN + 9
    For RA = 1 To 5
C3 = RA + 2
        If AE(RA) = AN(RN) Then
        Conta = Conta + 1
        If Conta = CD Then
            MsgBox "Trovato " & CD & "°"
            Range("J2:N2").Interior.ColorIndex = xlNone
            Cells(RRE, C3).Interior.ColorIndex = 6
            Range("C" & RRE - 1 & ":G" & RRE + 1).Copy Destination:=Range("J5")
            Cells(2, C1).Interior.ColorIndex = 6
            GoTo esci
            End If
        End If
    Next RA
Next RN
Next RRE
esci:
Range("P2").Value = CD
Next CD
Range("P2").Value = MVCD
End Sub


In P1 va inserito o Ambo o Estratto

Avendo fatto qualche ritocco alla macro "TrovaAmbi" preferisco allegare anche il File con la convalida elenco per la cella P1 (Estratto / Ambo)

Ciao

( psss, psss Statix, hai visto?
Anthony con solo quattro righe di codice ha ottenuto il risultato che ottengo io, con quattro pagine di macro... :cry: )
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Statix » 17/06/10 10:06

Ciao Flash30005,
ho provato e tutto ok per estratto della intera cinquina,
quello che ti chiedevo io,era di un solo singolo estratto in J2, cioè se in J2 metto 34 mi deve cercare per 10 volte(valore in P2) il 34,un altra modifica che si dovrebbe apportare se in R2 metto 2,
le linee(estrazioni) dovrebbe prenderne 2 sopra e 2 sotto più quella centrale dell'estratto o dell'ambo, naturalmente.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 17/06/10 12:20

Guarda, in questo caso, potremmo eliminare diverse righe di codice senza ottenere grandi miglioramenti in termini di esecuzione di elaborazione processo
quindi ti farò sostituire solo un valore di una riga nel codice della macro "TrovaEstr" (da valore attuale 5 a valore 1)
Codice: Seleziona tutto
AE(5) = Format(Cells(RRE, 7).Value, "00")  '<<< esistente, lasciare come è

For RN = 1 To 1  '<<<< cambiare il valore 5 con 1
C1 = RN + 9  '<<< esistente, lasciare come è


Fai sapere se tutto ok
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Statix » 17/06/10 13:43

Ciao Flash30005,
ho fatto anche la modifica delle estrazioni ,sotto e sopra in base al valore in R2
al momento sembra funzionare,riprovo stasera sul computer principale dove ho il programma vero e proprio.
tutto ok,
grazie ,un grazie anche ad Anthony . ;)
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Statix » 17/06/10 14:00

Ciao Flash30005,
ho appena scritto che era tutto ok, mi sono accorto di una cosa, :o
la macro quando trascrive i dati in J5,
se nelle estrazioni i dati C4:G1000 sono ricavati da formule ,mi trascrive anche le formule,
esempio se in C4 ho un cerca verticale archivio etc etc mi riporta la stessa formula in J5,
considerando che io successivamente ricopio i dati di J5:N7 su un altro foglio con incolla solo valori,
non dovrei avere problemi,ma ,mi resta sempre il dubbio che le celle possono subire delle variazioni durante i cicli.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 17/06/10 14:17

Non immaginavo ci fossero formule nelle estrazioni :roll:
Comunque modificando alcune linee di codice si risolve
ma preferisco inviare l'intero codice (tutte le macro) che dovrai sostituire
Codice: Seleziona tutto
Sub Avvio()
If Range("P1").Value = "Ambo" Then
Call TrovaAmbi
Else
Call TrovaEstr
End If
End Sub
Sub TrovaEstr()
UR = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
Dim VNR(5) As String
Dim VNE(5) As String
Dim AN(10) As String
Dim AE(10) As String
VCD = Range("P2").Value
MVCD = VCD
Range("J2:N2").Interior.ColorIndex = xlNone
Range("C4:G" & UR).Interior.ColorIndex = xlNone
Range("J5:N7").Clear
AN(1) = Format(Cells(2, 10).Value, "00")
AN(2) = Format(Cells(2, 11).Value, "00")
AN(3) = Format(Cells(2, 12).Value, "00")
AN(4) = Format(Cells(2, 13).Value, "00")
AN(5) = Format(Cells(2, 14).Value, "00")

For CD = VCD To 1 Step -1
Conta = 0
For RRE = 4 To UR
AE(1) = Format(Cells(RRE, 3).Value, "00")
AE(2) = Format(Cells(RRE, 4).Value, "00")
AE(3) = Format(Cells(RRE, 5).Value, "00")
AE(4) = Format(Cells(RRE, 6).Value, "00")
AE(5) = Format(Cells(RRE, 7).Value, "00")

For RN = 1 To 1
C1 = RN + 9
    For RA = 1 To 5
C3 = RA + 2
        If AE(RA) = AN(RN) Then
        Conta = Conta + 1
        If Conta = CD Then
            MsgBox "Trovato " & CD & "°"
            Range("J5:N7").Clear
            Range("C4:G" & UR).Interior.ColorIndex = xlNone
            Range("J2:N2").Interior.ColorIndex = xlNone
            Cells(RRE, C3).Interior.ColorIndex = 6
            Range("C" & RRE - 1 & ":G" & RRE + 1).Copy
                Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Cells(2, C1).Interior.ColorIndex = 6
            Cells(6, C3 + 7).Interior.ColorIndex = 6
            GoTo esci
            End If
        End If
    Next RA
Next RN
Next RRE
esci:
Range("P2").Value = CD
Next CD
Range("P2").Value = MVCD
End Sub

Sub TrovaAmbi()
UR = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
Dim VNR(5) As String
Dim VNE(5) As String
Dim AN(10) As String
Dim AE(10) As String
VCD = Range("P2").Value
MVCD = VCD
Range("J2:N2").Interior.ColorIndex = xlNone
Range("C4:G" & UR).Interior.ColorIndex = xlNone
Range("J5:N7").Clear
VNR(1) = Format(Cells(2, 10).Value, "00")
VNR(2) = Format(Cells(2, 11).Value, "00")
VNR(3) = Format(Cells(2, 12).Value, "00")
VNR(4) = Format(Cells(2, 13).Value, "00")
VNR(5) = Format(Cells(2, 14).Value, "00")

AN(1) = VNR(1) & VNR(2)
AN(2) = VNR(1) & VNR(3)
AN(3) = VNR(1) & VNR(4)
AN(4) = VNR(1) & VNR(5)
AN(5) = VNR(2) & VNR(3)
AN(6) = VNR(2) & VNR(4)
AN(7) = VNR(2) & VNR(5)
AN(8) = VNR(3) & VNR(4)
AN(9) = VNR(3) & VNR(5)
AN(10) = VNR(4) & VNR(5)
If Val(VNR(1)) > Val(VNR(2)) Then AN(1) = VNR(2) & VNR(1)
If Val(VNR(1)) > Val(VNR(3)) Then AN(2) = VNR(3) & VNR(1)
If Val(VNR(1)) > Val(VNR(4)) Then AN(3) = VNR(4) & VNR(1)
If Val(VNR(1)) > Val(VNR(5)) Then AN(4) = VNR(5) & VNR(1)
If Val(VNR(2)) > Val(VNR(3)) Then AN(5) = VNR(3) & VNR(2)
If Val(VNR(2)) > Val(VNR(4)) Then AN(6) = VNR(4) & VNR(2)
If Val(VNR(2)) > Val(VNR(5)) Then AN(7) = VNR(5) & VNR(2)
If Val(VNR(3)) > Val(VNR(4)) Then AN(8) = VNR(4) & VNR(3)
If Val(VNR(3)) > Val(VNR(5)) Then AN(9) = VNR(5) & VNR(3)
If Val(VNR(4)) > Val(VNR(5)) Then AN(10) = VNR(5) & VNR(4)

For CD = VCD To 1 Step -1
Conta = 0
For RRE = 4 To UR
VNE(1) = Format(Cells(RRE, 3).Value, "00")
VNE(2) = Format(Cells(RRE, 4).Value, "00")
VNE(3) = Format(Cells(RRE, 5).Value, "00")
VNE(4) = Format(Cells(RRE, 6).Value, "00")
VNE(5) = Format(Cells(RRE, 7).Value, "00")

AE(1) = VNE(1) & VNE(2)
AE(2) = VNE(1) & VNE(3)
AE(3) = VNE(1) & VNE(4)
AE(4) = VNE(1) & VNE(5)
AE(5) = VNE(2) & VNE(3)
AE(6) = VNE(2) & VNE(4)
AE(7) = VNE(2) & VNE(5)
AE(8) = VNE(3) & VNE(4)
AE(9) = VNE(3) & VNE(5)
AE(10) = VNE(4) & VNE(5)
If Val(VNE(1)) > Val(VNE(2)) Then AE(1) = VNE(2) & VNE(1)
If Val(VNE(1)) > Val(VNE(3)) Then AE(2) = VNE(3) & VNE(1)
If Val(VNE(1)) > Val(VNE(4)) Then AE(3) = VNE(4) & VNE(1)
If Val(VNE(1)) > Val(VNE(5)) Then AE(4) = VNE(5) & VNE(1)
If Val(VNE(2)) > Val(VNE(3)) Then AE(5) = VNE(3) & VNE(2)
If Val(VNE(2)) > Val(VNE(4)) Then AE(6) = VNE(4) & VNE(2)
If Val(VNE(2)) > Val(VNE(5)) Then AE(7) = VNE(5) & VNE(2)
If Val(VNE(3)) > Val(VNE(4)) Then AE(8) = VNE(4) & VNE(3)
If Val(VNE(3)) > Val(VNE(5)) Then AE(9) = VNE(5) & VNE(3)
If Val(VNE(4)) > Val(VNE(5)) Then AE(10) = VNE(5) & VNE(4)

For RN = 1 To 10
Select Case RN
Case 1 To 4
C1 = 1
C2 = RN + C1
Case 5 To 7
C1 = 2
C2 = RN - C1
Case 8 To 9
C1 = 3
C2 = RN - C1 - 1
Case 10
C1 = 4
C2 = 5
End Select
C1 = C1 + 9
C2 = C2 + 9
    For RA = 1 To 10
   
Select Case RA
Case 1 To 4
C3 = 1
C4 = RA + C3
Case 5 To 7
C3 = 2
C4 = RA - C3
Case 8 To 9
C3 = 3
C4 = RA - C3 - 1
Case 10
C3 = 4
C4 = 5
End Select
C3 = C3 + 2
C4 = C4 + 2
   
        If AE(RA) = AN(RN) Then
        Conta = Conta + 1
        If Conta = CD Then
            MsgBox "Trovato " & CD & "°"
            Range("J5:N7").Clear
            Range("J2:N2").Interior.ColorIndex = xlNone
            Range("C4:G" & UR).Interior.ColorIndex = xlNone
            Cells(RRE, C3).Interior.ColorIndex = 6
            Cells(RRE, C4).Interior.ColorIndex = 6
            Range("C" & RRE - 1 & ":G" & RRE + 1).Copy
            Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Cells(2, C1).Interior.ColorIndex = 6
            Cells(2, C2).Interior.ColorIndex = 6
            Cells(6, C3 + 7).Interior.ColorIndex = 6
            Cells(6, C4 + 7).Interior.ColorIndex = 6
            GoTo esci
            End If
        End If
    Next RA
Next RN
Next RRE
esci:
Range("P2").Value = CD - 1
Next CD
Range("P2").Value = MVCD
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Statix » 17/06/10 14:45

Ok tutto a posto,
per quanto riguarda le estrazioni,
io uso il cerca verticale per estrapolarmi le estrazioni dall'archivio,modificando l'indice mi cambio la ruota,
a volte capita che devo mettere in testa l'ultima estrazione e con la -1 mi creo l'archivio,
rendo così l'estrazioni anche scorrevoli,
questo è molto comodo,
l'unico problema, che ho una formula per ogni estratto ,se l'estrazioni sono migliaia avrò migliaia di formule,
che mi rallentano il computer.
Hai qualche soluzione migliore per ovviare a tutto questo? e rendere tutto più veloce?
quanto può rallentare un 6/7 mila cerca verticale ?
a volte ho provato con un copia e incolla valori,ma sembra che sia la stessa cosa.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Statix » 17/06/10 20:45

Ciao Flash30005
è sorto un altro problema,
se in una estrazione c'è un terno, la macro lo considera 3 volte ambo,
come già risposto in precedenza alla domanda di Anthony
di come veniva considerata, sempre 1
Anthony47 ha scritto:Una linea che contenesse un terno come lo devi contare, 1 o 3?

Ciao
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Flash30005 » 17/06/10 21:47

Quindi?

Fai un esempio pratico.
(Deve prendere in considerazione solo il primo ambo di quel terno e poi proseguire con gli ambi delle estrazioni successive?)
Mi sembra un controsenso ma se deve essere così... :roll:

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Excel Trova ambo

Postdi Statix » 17/06/10 22:07

Ciao flash
la macro deve contare solo se è presente un ambo in ogni estrazione,
se poi li evidenzia tutti e 3 ancora meglio.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Trova ambo

Postdi Anthony47 » 18/06/10 01:29

Ho modificato la mia macro per inserire le varianti richieste:
-se in P1 c' e' "ambo" controlla in J2:N2, altrimenti controlla solo in J2
-se in R2 c' e' "2" prende 2 righe prima e 2 dopo, altrimenti 1 riga prima e dopo
-colora le celle dell' elenco
-esegue Copy /PasteSpecial e non Copy /Paste
Codice: Seleziona tutto
Sub piStat2()
Dim MxAdr(5) As String, CCMax As Integer, HMany As Integer
Dim J As Integer, I As Integer, CCCount As Integer, VOff As Integer
'
LastR = Cells(Rows.Count, 3).End(xlUp).Row
Range("C4:G" & LastR).Interior.ColorIndex = xlNone
Range("J4:N" & LastR).Clear
If UCase([P1].Value) <> "AMBO" Then HMany = 1 Else HMany = 5
If UCase([P1].Value) <> "AMBO" Then CCMax = 1 Else CCMax = 2
If [R2] = 2 Then VOff = 2 Else VOff = 1

'
For I = 0 To LastR
Range("C4:G4").Offset(I, 0).Select
CCount = 0
For Each Cella In Range("C4:G4").Offset(I, 0)
If Application.WorksheetFunction.CountIf(Range("J2").Resize(1, HMany), Cella.Value) > 0 Then _
  MxAdr(CCount) = Cella.Address
CCount = CCount + Application.WorksheetFunction.CountIf(Range("J2").Resize(1, HMany), Cella.Value)
If CCount >= CCMax Then Exit For
Next Cella
If CCount >= CCMax Then
    For J = 0 To CCount - 1
        Range(MxAdr(J)).Interior.ColorIndex = 4
    Next J
    Range("C4:G4").Offset(I - VOff, 0).Resize(2 * VOff + 1, 5).Copy
    Range("J5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Ambo = Ambo + 1
End If
If Ambo >= Range("P2").Value Then Exit For
Next I
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Excel Trova ambo":


Chi c’è in linea

Visitano il forum: Gianca532011 e 67 ospiti