Condividi:        

vorrei automatizzare diverse operazioni

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

vorrei automatizzare diverse operazioni

Postdi luca0202 » 12/03/11 13:52

Buongiorno mi rivolgo ancora a voi per le vostre competenze ....
Avrei un foglio excel con archivio estrazioni del lotto aggiornabile via web e foglio 1 dove ci sono le operazioni che vorrei fare:
1° Dal foglio archivio esportare le ultime 18 estrazioni in foglio 1 (senza la data).
2° Con formattazione A21 faccio evidenziare il numero che a me interessa (in questo caso il 40).
3° Ora con delle sigle AS(alto sinitra)AC(alto centro)AD(alto destra)CD(centro destra)BD(basso destra)BC(basso centro)BS(basso sinistra)CS(centro sinistra), vado a definre i numeri che circondano in questo caso il 40 presente in queste ultime 18 estrazioni.
4° Con formattazione delle colonne sigle vado a vedere se ci sono valori duplicati nella medesima sigla.
5°Conto le rispettive presenza dei numeri che il 40 in questo caso mi ha dato.
Ora la maggior parte di queste operazioni le faccio manualmente o con il supporto di altri fogli ,quello che chiedo se possibile creare un bottoncino magico che una volta scelto il numero (in questo caso il 40) il resto lo faccio in automatico .
Ringrazio anticipatamente per eventuali riscontri Luca .
Allego il file .....http://www.megaupload.com/?d=E4ZWMSHZ
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Sponsor
 

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 13/03/11 00:15

Non mi è molto chiaro come scegli l'AS (alto a sinistra) e poi inserisci questi valori
70
46
4
21
57
30
87

Compreso questo penso di comprendere come estrapoli le altre sigle

fai sapere
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 13/03/11 08:05

Immagine

Uploaded with ImageShack.us
Allego immagine con l'esempio di uno dei 40 con le rispettive sigle che lo circondano ,se si guarda archivio indiduato il numero questo diventa il fulcro di altri 8 numeri che hanno delle posizioni che io definito con quelle sigle , 8 numeri sono teorici dipende da dove si trova il numero stesso . Spero di aver chiarito qualcosina ....Grazie per l'interessamento Luca
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 13/03/11 19:14

Una macro che assolve quanto da te richiesto potrebbe essere questa

Codice: Seleziona tutto
Sub CopiaArchivio()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Sheets("archivio").Select
    Range("D2:BF19").Select
    Selection.Copy
    Sheets("Foglio1").Select
    Columns("A:BC").Clear
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("archivio").Select
    Range("D2:BF20").Select
    Selection.Copy
    Sheets("Foglio1").Select
    ActiveSheet.Paste
    Range("A21").FormulaR1C1 = Range("BE1").Value
    Range("A21").Interior.ColorIndex = 6
    Application.CutCopyMode = False
    Range("D20").FormulaR1C1 = "AS"
    Range("E20").FormulaR1C1 = "AC"
    Range("F20").FormulaR1C1 = "AD"
    Range("G20").FormulaR1C1 = "CD"
    Range("H20").FormulaR1C1 = "BD"
    Range("I20").FormulaR1C1 = "BC"
    Range("J20").FormulaR1C1 = "BS"
    Range("K20").FormulaR1C1 = "CS"
    Range("D21").Select
    Columns("A:BC").EntireColumn.AutoFit
Call Ricerca
Call CercaPresenze 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Ricerca()
Area = "A2:BC19"
Valore = Range("A21").Value
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(Valore, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            Worksheets("Foglio1").Cells(C.Row, C.Column).Interior.ColorIndex = 6
            URAS = Range("D" & Rows.Count).End(xlUp).Row + 1
            URAC = Range("E" & Rows.Count).End(xlUp).Row + 1
            URAD = Range("F" & Rows.Count).End(xlUp).Row + 1
            URCD = Range("G" & Rows.Count).End(xlUp).Row + 1
            URBD = Range("H" & Rows.Count).End(xlUp).Row + 1
            URBC = Range("I" & Rows.Count).End(xlUp).Row + 1
            URBS = Range("J" & Rows.Count).End(xlUp).Row + 1
            URCS = Range("K" & Rows.Count).End(xlUp).Row + 1
            If C.Row <> 2 Then
                Range("D" & URAS).Value = .Cells(C.Row - 2, C.Column - 1).Value
                Range("E" & URAC).Value = .Cells(C.Row - 2, C.Column).Value
                Range("F" & URAD).Value = .Cells(C.Row - 2, C.Column + 1).Value
            End If
            If C.Row < 19 Then                  '<<<<<<< Aggiunta condizione ore 19:30
                Range("H" & URBD).Value = .Cells(C.Row, C.Column + 1).Value
                Range("I" & URBC).Value = .Cells(C.Row, C.Column).Value
                Range("J" & URBS).Value = .Cells(C.Row, C.Column - 1).Value
            End If
            Range("G" & URCD).Value = .Cells(C.Row - 1, C.Column + 1).Value
            Range("K" & URBS).Value = .Cells(C.Row - 1, C.Column - 1).Value
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
End Sub


Aggiunta macro "CercaPresenze"

Codice: Seleziona tutto
Sub CercaPresenze()

    Range("P20").FormulaR1C1 = "Calcolo Presenze"
    Range("O21").FormulaR1C1 = "3"
    Range("O22").FormulaR1C1 = "2"
    Range("O23").FormulaR1C1 = "1"
    Range("O21:O23").Interior.ColorIndex = 6

Righe = Range("D2").CurrentRegion.Rows.Count

Area = "D21:K" & Righe
For NN = 1 To 90
NP = 0
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(NN, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            If C = NN Then NP = NP + 1
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
If NP = 1 Then
UC1 = Worksheets("Foglio1").Range("IV23").End(xlToLeft).Column + 1
Cells(23, UC1).Value = NN
End If
If NP = 2 Then
UC2 = Worksheets("Foglio1").Range("IV22").End(xlToLeft).Column + 1
Cells(22, UC2).Value = NN
End If
If NP = 3 Then
UC3 = Worksheets("Foglio1").Range("IV21").End(xlToLeft).Column + 1
Cells(21, UC3).Value = NN
End If
If NP > 3 Then MsgBox "Attenzione! Il Numero " & NN & " è presente " & NP & " volte"
Next NN
End Sub


Devi solo impostare il Valore "40" nella cella BE1 del "Foglio1"

N.B. I valori trovati non sono nello stesso ordine dei tuoi

Fai sapere
ciao

ATT. Corretta macro "Ricerca" ore 19:30 e aggiunta macro "CercaPresenze" ore 20:40- Flash
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 13/03/11 22:12

Ho provato ad inserire le macro ma a me da un errore in righe = (in cerca presenze) ...Forse sono io che non le so inserire correttamente ...se il tuo foglio funziona me lo potresti inviare cosi possa vedere se era quello che intendevo ....Grazie Luca
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 13/03/11 22:20

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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 13/03/11 22:37

Funziona sei un grande Flash ...però non fa piu' aggiornamento estrazioni via web e quando conta + di 3 presenze viene il messaggio e non viene trascritto quel valore io avevo messo solo fino a 3 perchè in quel caso non si andava oltre ....comunque davvero ottimo lavoro ancora Grazie Luca
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi luca0202 » 13/03/11 22:53

Un altro piccolo intoppo se inserisco il 90 da un errore ...
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 13/03/11 23:07

In effetti il "90" si trova anche sulla prima colonna pertanto va in errore perché non esiste la colonna 0 (c.column-1)
quindi devi inserire delle condizioni relative a questa possibilità
invio la macro "Ricerca" modificata
Codice: Seleziona tutto
Sub Ricerca()
Area = "A2:BC19"
Valore = Range("A21").Value
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(Valore, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            Worksheets("Foglio1").Cells(C.Row, C.Column).Interior.ColorIndex = 6
            URAS = Range("D" & Rows.Count).End(xlUp).Row + 1
            URAC = Range("E" & Rows.Count).End(xlUp).Row + 1
            URAD = Range("F" & Rows.Count).End(xlUp).Row + 1
            URCD = Range("G" & Rows.Count).End(xlUp).Row + 1
            URBD = Range("H" & Rows.Count).End(xlUp).Row + 1
            URBC = Range("I" & Rows.Count).End(xlUp).Row + 1
            URBS = Range("J" & Rows.Count).End(xlUp).Row + 1
            URCS = Range("K" & Rows.Count).End(xlUp).Row + 1
            If C.Row <> 2 Then
                If C.Column > 1 Then Range("D" & URAS).Value = .Cells(C.Row - 2, C.Column - 1).Value
                Range("E" & URAC).Value = .Cells(C.Row - 2, C.Column).Value
                Range("F" & URAD).Value = .Cells(C.Row - 2, C.Column + 1).Value
            End If
            If C.Row < 19 Then
                Range("H" & URBD).Value = .Cells(C.Row, C.Column + 1).Value
                Range("I" & URBC).Value = .Cells(C.Row, C.Column).Value
                If C.Column > 1 Then Range("J" & URBS).Value = .Cells(C.Row, C.Column - 1).Value
            End If
            Range("G" & URCD).Value = .Cells(C.Row - 1, C.Column + 1).Value
            If C.Column > 1 Then Range("K" & URBS).Value = .Cells(C.Row - 1, C.Column - 1).Value
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 14/03/11 06:36

Ora non da errore ma con il 90 non fa quello che dovrebbe fare arriva a fare un po' di caos con i numeri laterali o perlomeno quelli che non hanno 8 numeri ... senza abusare della tua disponibilita' ti avevo scritto un altro paio di cose prima dell'errore del 90 ....cioè che non mi da più la possibilità di aggiornare archivio via web e il fatto che non scrive le presenze superiori a 3 ... Luca
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 14/03/11 09:28

Dal tuo primo messaggio di questo topic mi sembra di capire che l'aggiornamento da web avviene automaticamente
luca0202 ha scritto:Avrei un foglio excel con archivio estrazioni del lotto aggiornabile via web e foglio 1 dove ci sono le operazioni che vorrei fare...

Pertanto, ho lavorato sul foglio1 non sull'aggiornamento da web, per fare questo crei una query-web mentre registri la macro, (anche perché non so proprio dove andare prendere i dati di quell'archivio).

Per quanto riguarda il numero di presenze nel tuo foglio erano riportate da 3 a 1 presenze, pertanto ho inserito io stesso il messaggio, per non perdere l'informazione, che si stava superando il numero previsto (le 3 presenze).
Inoltre, se prevedevi di trascrivere tutte le presenze avresti dovuto impostare come primo valore presenza 1 fino al numero di presenze trovato, quindi in ordine crescente e non decrescente altrimenti come faccio ad inserire 4 o 5 presenze? Se andassi a ritroso partendo dalla riga 23 con presenza "1", cancellerei parte dell'archivio, non credi?
Oppure pensi che debba scansionare una prima volta per sapere qual'è il valore massimo delle presenze per iniziare a inserire questo valore alla riga 21 per poi scendere di riga, ciò comporterebbe una doppia esecuzione della macro che vorrei evitare. 8)

Devo fare una nota sullo schema dei dati da te impostato in quanto non è corretto mettere un'analisi al di sotto dell'archivio da analizzare e che varia soprattutto se questa analisi prevede una testata che deve essere trascritta per via della pulizia dei dati che si effettua ad ogni avvio. E' pertanto più corretto inserire l'analisi a fianco delle colonne archivio riprodotto o addirittura su un altro foglio.
Inoltre, dovendo rilevare gli 8 numeri adiacenti su ogni lato del valore cercato, avresti dovuto lasciare una riga e/o colonna intorno al range delle estrazioni (in pratica iniziare dalla colonna B) quindi avremmo avuto il valore 84 di Bari in B3 e non in A2 (oppure, se non è necessaria la testata delle ruote in questa analisi, il valore 84 potrebbe stare in B2, lasciando vuota la prima riga del foglio)
Tutto ciò avrebbe semplificato l'intera macro in quanto le celle vuote non vengono prese in considerazione mentre trovando il nome delle ruote in alto, le sigle AS, AC in basso e nessuna colonna a sinistra la macro diventa più complessa per via delle diverse condizioni da inserire.

Se vuoi sistemare diversamente i dati analizzati possiamo farlo modificando interamente la macro

Per quanto riguarda il numero 90 dovresti indicarmi dove rilevi l'errore

fai sapere
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 14/03/11 19:11

Faccio una premessa confessando la mia ignoranza in materia in applicazioni office e cerco di rispondere .... dal mio primo messaggio ti sembrava di capire quello che ho scritto perchè in effetti il foglio che avevo inviato http://www.megaupload.com/?d=E4ZWMSHZ io lo avevo trovato online in questo era possibile aggiornare via web nella voce archivio con un errore di debug probabilmente perchè faceva anche altre cose che a me non interessavano e io ho cancellato ma l'aggiornamento lo faceva comunque .E l'aggiornamento mi sarebbe servito per la ragione che io prima di andare a fare le mie analisi avrei estrapolato solamente le ultime 18 estrazioni infatti avevo scritto "1° Dal foglio archivio esportare le ultime 18 estrazioni in foglio 1 (senza la data)."Hai ragione quando dici "il numero di presenze nel tuo foglio erano riportate da 3 a 1 presenze" ma era perchè in quella prova con il 40 in quel contesto non si andava oltre le 3 presenze è stato solo il caso del mio esempio che voleva così fosse probabile non mi sia spiegato bene ....Poi tu di note me ne puoi fare 1000 che io accolto tutte piu' che volentieri ....nel modo in qui io ho impostato il foglio era più che altro per farti rendere conto di che cosa avrei avuto bisogno il concetto praticamente se poi il tutto sarebbe stato impostato diversamente per esigenze di macro o altro ....nessun problema davvero ...Per quando riguarda il 90 se provi ad inserirlo ti renderai conto che non fa la stessa cosa come con gli altri numeri e facendo prove stasera mi sono reso conto che anche i numeri da 1 al 9 creano qualche problema ...Grazie Luca
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 14/03/11 22:59

Quindi se non hai problema di schema dati output, mi dai piena libertà di fare a modo mio? (rispettando ciò che vorresti ottenere?)

Fai sapere
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 14/03/11 23:08

Ma certamenteeee !!!
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 14/03/11 23:12

qual'è il sito dove scaricavi l'archivio?
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 14/03/11 23:51

Non so se posso mettere i link ....comunque sia "televideo rai lotterie lotto " oppure "lottomatica lotto "
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 15/03/11 00:33

Intanto prova questa macro per quanto riguarda i dati, tralasciando, per il momento, l'aggiornamento dell'archivio
(La prima volta pulisci tutte le celle del foglio1
In BF metti il valore da ricercare
in BH1:BF1 le sigle (AS,AC,AD,CD,BD,BC,BS,CS) e
in BT1 la stringa "Calcolo Presenze"

Codice: Seleziona tutto
Sub CopiaArchivio()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Sheets("archivio").Select
    Sheets("Foglio1").Select
    Range("B2:IV200").Clear
    Application.CutCopyMode = False
    Range("B2").Select
    Sheets("archivio").Select
    Range("D3:BF20").Select
    Selection.Copy
    Sheets("Foglio1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Call Ricerca
Call CercaPresenze
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Ricerca()
Area = "B2:BC19"
Valore = Range("BF1").Value
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(Valore, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
        RN = C.Row
        CN = C.Column
            Worksheets("Foglio1").Cells(C.Row, C.Column).Interior.ColorIndex = 6
            URAS = Range("BH" & Rows.Count).End(xlUp).Row + 1
            URAC = Range("BI" & Rows.Count).End(xlUp).Row + 1
            URAD = Range("BJ" & Rows.Count).End(xlUp).Row + 1
            URCD = Range("BK" & Rows.Count).End(xlUp).Row + 1
            URBD = Range("BL" & Rows.Count).End(xlUp).Row + 1
            URBC = Range("BM" & Rows.Count).End(xlUp).Row + 1
            URBS = Range("BN" & Rows.Count).End(xlUp).Row + 1
            URCS = Range("BO" & Rows.Count).End(xlUp).Row + 1
            Range("BH" & URAS).Value = .Cells(RN - 2, CN - 2).Value
            Range("BI" & URAC).Value = .Cells(RN - 2, CN - 1).Value
            Range("BJ" & URAD).Value = .Cells(RN - 2, CN).Value
            Range("BK" & URCD).Value = .Cells(RN - 1, CN).Value
            Range("BL" & URBD).Value = .Cells(RN, CN).Value
            Range("BM" & URBC).Value = .Cells(RN, CN - 1).Value
            Range("BN" & URBS).Value = .Cells(RN, CN - 2).Value
            Range("BO" & URCS).Value = .Cells(RN - 1, CN - 2).Value
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
End Sub

Sub CercaPresenze()

    Range("BT2").FormulaR1C1 = "1"
    Range("BT3").FormulaR1C1 = "2"
    Range("Bt4").FormulaR1C1 = "3"
    Range("Bt5").FormulaR1C1 = "4"
    Range("Bt6").FormulaR1C1 = "5"
    Range("Bt7").FormulaR1C1 = "6"
    Range("Bt8").FormulaR1C1 = "7"
    Range("Bt9").FormulaR1C1 = "8"
    Range("Bt10").FormulaR1C1 = "9"
    Range("Bt11").FormulaR1C1 = "10"
    Range("BT1:BT11").Interior.ColorIndex = 6
Righe = Range("BH2").CurrentRegion.Rows.Count
Area = "BH2:BO" & Righe
For NN = 1 To 90
Np = 0
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(NN, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            If C = NN Then Np = Np + 1
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
If Np > 0 Then
    UC1 = Worksheets("Foglio1").Range("IV" & Np + 1).End(xlToLeft).Column + 1
    Cells(Np + 1, UC1).Value = NN
End If
Next NN
End Sub


invio anche questo file

Fai sapere
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 15/03/11 09:21

Diciamo che qualcosa va e altro un po' meno ....il foglio va benissimo anche impostato come lo hai messo tu ....va bene che preleva le ultime 18 estrazioni ....provato con diversi numeri e finchè i numeri sono nel mezzo del tabellone non ci sono problemi è perfetto, quando va ad analizzare gli esterni non fa quello che dovrebbe .... e i numeri della colonna BD nemmeno li considera ... altra cosa che se io inserisco un numero da 1 a 8 (numeretti) lui se esmpio inserisco 1 va a trovare tutti i numeri che contengono l' 1 cioè 10 11 12 13 14 15 16 17 18 19 21 31 41 51 61 71 81 ....allego comunque immagine .... e link per estrazioni http://www.lottomaticaitalia.it/lotto/r ... ltime.html
Immagine
Luca
Uploaded with ImageShack.us
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Re: vorrei automatizzare diverse operazioni

Postdi Flash30005 » 15/03/11 11:39

Per quanto riguarda la colonna BD ti dò ragione in quanto non avevo aggiornato l'Area (spostamento di una colonna della matrice)
Per i numeri ai bordi funziona tutto regolarmente
ed è regolare anche con i numeri da 1 a 8 ti invio il file con la ricerca del numero 1 che troverai anche nel bordo superiore, infatti, in quel caso, in AS, AC, AD non viene trascritto alcun valore
(prova con il debug e procedi passo passo)

Ho reso più "estetica" la macro ma la funzionalità è la stessa di prima

Codice: Seleziona tutto
Sub CopiaArchivio()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Sheets("archivio").Select
    Sheets("Foglio1").Select
    Range("B2:IV200").Clear
    Application.CutCopyMode = False
    Range("B2").Select
    Sheets("archivio").Select
    Range("D3:BF20").Select
    Selection.Copy
    Sheets("Foglio1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Call Ricerca
Call CercaPresenze
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Ricerca()
Area = "B2:BD19"
Valore = Range("BF1").Value
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(Valore, LookIn:=xlFormulas, LookAt:=xlWhole)
    'Set C = .Find(Valore, LookIn:=xlValues)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
        RN = C.Row
        CN = C.Column
            Worksheets("Foglio1").Cells(C.Row, C.Column).Interior.ColorIndex = 6
            Cells(Rows.Count, 60).End(xlUp).Offset(1, 0).Value = Cells(RN - 1, CN - 1).Value
            Cells(Rows.Count, 61).End(xlUp).Offset(1, 0).Value = Cells(RN - 1, CN).Value
            Cells(Rows.Count, 62).End(xlUp).Offset(1, 0).Value = Cells(RN - 1, CN + 1).Value
            Cells(Rows.Count, 63).End(xlUp).Offset(1, 0).Value = Cells(RN, CN + 1).Value
            Cells(Rows.Count, 64).End(xlUp).Offset(1, 0).Value = Cells(RN + 1, CN + 1).Value
            Cells(Rows.Count, 65).End(xlUp).Offset(1, 0).Value = Cells(RN + 1, CN).Value
            Cells(Rows.Count, 66).End(xlUp).Offset(1, 0).Value = Cells(RN + 1, CN - 1).Value
            Cells(Rows.Count, 67).End(xlUp).Offset(1, 0).Value = Cells(RN, CN - 1).Value
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
End Sub

Sub CercaPresenze()

    Range("BT2").FormulaR1C1 = "1"
    Range("BT3").FormulaR1C1 = "2"
    Range("Bt4").FormulaR1C1 = "3"
    Range("Bt5").FormulaR1C1 = "4"
    Range("Bt6").FormulaR1C1 = "5"
    Range("Bt7").FormulaR1C1 = "6"
    Range("Bt8").FormulaR1C1 = "7"
    Range("Bt9").FormulaR1C1 = "8"
    Range("Bt10").FormulaR1C1 = "9"
    Range("Bt11").FormulaR1C1 = "10"
    Range("BT1:BT11").Interior.ColorIndex = 6
Righe = Range("BH2").CurrentRegion.Rows.Count
Area = "BH2:BO" & Righe
For NN = 1 To 90
NP = 0
With Worksheets("Foglio1").Range(Area)
    Set C = .Find(NN, LookIn:=xlFormulas, LookAt:=xlWhole)
    If Not C Is Nothing Then
        firstAddress = C.Address
        Do
            If C = NN Then NP = NP + 1
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> firstAddress
    End If
End With
If NP > 0 Then
    Cells(NP + 1, Columns.Count).End(xlToLeft).Offset(0, 1).Value = NN
End If
Next NN
End Sub

Nel caso del numero 90 ce ne sono 17, ammettendo che nessun numero 90 si trovasse sul bordo
avremmo 136 numeri (90x17)
ma 4 valori "90" giacciono sul bordo, quindi avremo 12 numeri in meno (4x3)per un totale di numeri presenti pari a 124

Se fai il conteggio dei numeri selezionando l'area da BH2 a BO18 avrai come risultato 124 numeri

Download File

Fai sapere
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: vorrei automatizzare diverse operazioni

Postdi luca0202 » 15/03/11 13:27

Come conteggio presenze quello che mi hai detto è giusto ....ma è l'ordinamento che fa nelle sigle che non mi torna ho inserito il 90 e ti mostra come viene e come dovrebbe essere per come la intendo io ....Luca
Immagine

Uploaded with ImageShack.us
luca0202
Utente Junior
 
Post: 56
Iscritto il: 20/08/10 10:56

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "vorrei automatizzare diverse operazioni":

Vorrei aprire un file
Autore: franco11
Forum: Software Windows
Risposte: 4

Chi c’è in linea

Visitano il forum: Nessuno e 26 ospiti