Previous page | 1 | Next page

verifica corrispondenza codici e cerca un numero

Last Update: 10/27/2021 9:31 PM
Author
Print | Email Notification    
Post: 7
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/24/2021 10:21 AM
 
Modify
 
Delete
 
Quote

ciao
tramite macro vorrei prelevare dei numeri
rispettando una " matrice"

provo a descrivere:
in fgl ritardatari col BA2:BA56
ho 55 codici che rimarranno fissi cosi

in col A2 ho gli stessi codici ma disposti in maniera "confusa"

in col I1 ho dei numei che sono quelli da riportare poi in col B2
con la seguente procedura.

Es
col A3 ho la scritta PA3 indica il 3zo numero di palermo
che controllando col I corrisponde al num 90

col A5 ho la scritta BA2 indica la ruota di bari il 2do estratto
che controllando col I corrisponde al num 73

e cosi via , le righe da controllare di col A sono 4950
quindi devo arrivare fino alla riga 4951

vi allego il file

ciao


Post: 3,231
Registered in: 4/6/2013
Location: ROMA
Age: 74
Master User
2010
OFFLINE
10/24/2021 11:26 AM
 
Modify
 
Delete
 
Quote

ciao
Prima di tutto in col. J, al posto delle ruote per esteso, metti le sigle:
BA-CA-FI...etc etc

Poi prova:
Sub Corrispondenza()
Dim ur As Long, rp As String, rt As String, ps As Integer, rng As Range, riga As Integer
ur = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("J1:J51")
Application.Calculation = xlCalculationManual
For j = 2 To ur
    rp = Cells(j, 1)
    rt = Left(rp, 2)
    ps = Right(rp, 1)
    riga = Application.WorksheetFunction.Match(rt, rng, 0)
    For i = riga To riga + 4
        If Cells(i, 8) = ps Then
            Cells(j, 2) = Cells(i, 9)
            Exit For
        End If
    Next i
Next j
Application.Calculation = xlCalculationAutomatic
msgbox "Done!"
End Sub


NB: é opportuno che ti inserisca una gestione di errori

Non si capisce a che serva la col. BA....

saluti




[Edited by dodo47 10/24/2021 11:29 AM]
Domenico
Win 10 - Excel 2016
Post: 7
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/24/2021 11:33 AM
 
Modify
 
Delete
 
Quote

ciao

si blocca con questa scritta da immagine

-----
>> Non si capisce a che serva la col. BA.... <<

pensavo servisse x avere i riferimenti

ciao
Post: 3,232
Registered in: 4/6/2013
Location: ROMA
Age: 74
Master User
2010
OFFLINE
10/24/2021 11:44 AM
 
Modify
 
Delete
 
Quote

ciao
manda il file con quanto hai fatto

saluti




Domenico
Win 10 - Excel 2016
Post: 8
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/24/2021 11:47 AM
 
Modify
 
Delete
 
Quote

ciao

tutto ok

chiedo "venia " colpa mia....😥

non avevo letto dove mni dicevi di rinominare la col J


cosa intendi x gestione errori ?


grazie

[Edited by raimea 10/24/2021 11:47 AM]
Post: 6,565
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
10/24/2021 11:51 AM
 
Modify
 
Delete
 
Quote

Ciao Ecco la mia soluzione, ti allego il file

Sub RicPos() 'ricerca Posizione
Dim r, c, d, p, n, x, y, rn1, rn2, arr1, Fine As Double, Inizio As Double

r = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2:B" & r).ClearContents
rn1 = Range("A2:A" & r)
Application.ScreenUpdating = False
Inizio = Timer
arr1 = Range("BA2:BA56")
r = Cells(Rows.Count, 9).End(xlUp).Row
rn2 = Range("I1:I" & r)
For y = 1 To UBound(rn2)
  n = rn2(y, 1)
  p = arr1(y, 1)
  For x = 1 To UBound(rn1)
    If rn1(x, 1) = p Then
      Cells(x + 1, 2) = n
    End If
  Next x
Next y
Cells(1, 1).Select
Application.ScreenUpdating = True
Fine = Timer
MsgBox ("Tempo impiegato " & Round((Fine - Inizio), 2) & " secondi")
End Sub


ci mette circa 11 secondi

Ciao By Sal (8-D
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie





Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 9
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/24/2021 12:25 PM
 
Modify
 
Delete
 
Quote

ottimo
tutto ok

grazie ad entrabi

ciao
Post: 10
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/24/2021 5:46 PM
 
Modify
 
Delete
 
Quote

ciao
ho letto i post successivi al mio riguardo a colora numeri ecc...

sono d accordo che nel forum si debba tentare poi di imparare.
ma vi assicuroi x me non e' facile !

quindi sono a chiedere se potete commentarmi questa macro
la parte centrale, che non so tradurre/ leggere:

[TESTO vb::Sub Riportainumei() 'ricerca Posizione Dim ur As Long, rp As String, rt As String, ps As Integer, rng As Range, riga As Integer inizio = Timer ur = Range("A" & Rows.Count).End(xlUp).Row Set rng = Range("J1:J51") ' ok Application.Calculation = xlCalculationManual For J = 2 To ur ' parti dalla 2da riga '-------poi qui non la so leggere ------- rp = Cells(J, 1) rt = Left(rp, 2) ps = Right(rp, 1) riga = Application.WorksheetFunction.Match(rt, rng, 0) For I = riga To riga + 4 If Cells(I, 8) = ps Then Cells(J, 2) = Cells(I, 9) Exit For End If Next I Next J Application.Calculation = xlCalculationAutomatic fine = Timer MsgBox ("Tempo impiegato " & Round((fine - inizio), 2) & " secondi") End Sub]



non riesco a caricare il formato codice ! 🙄

ciao


[Edited by raimea 10/24/2021 5:52 PM]
Post: 6,567
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
10/25/2021 8:34 AM
 
Modify
 
Delete
 
Quote

Ciao Raimea, ti passo la mia macro commentata, ho aggiunto il blocco delle formule ed il tempo è sceso da circa 11 secondi a circa mezzo secondo 0,34.

Domenico che saluto ti commenterà la sua

questa la macro

Sub RicPos() 'ricerca Posizione
Dim r, c, d, p, n, x, y, rn1, rn2, arr1, Fine As Double, Inizio As Double

Application.Calculation = xlCalculationManual 'blocca le formule
r = Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga colonna A
Range("B2:B" & r).ClearContents 'pulisce dati in colonna B
rn1 = Range("A2:A" & r) 'prende tutti i dati della colonna A
Application.ScreenUpdating = False 'blocca lo scermo
Inizio = Timer 'inizializza cronometro
arr1 = Range("BA2:BA56") 'prende le sigle delle ruote
r = Cells(Rows.Count, 9).End(xlUp).Row 'ultima riga colonna H
rn2 = Range("I1:I" & r) 'prende estrazione colonna H
For y = 1 To UBound(rn2) '1° ciclo scorre i numeri dell'estrazione
  n = rn2(y, 1) 'numero dell'estrazione
  p = arr1(y, 1) 'sigla dell'estrazione "Ba1-2-3-etc" Array colonna BA
  For x = 1 To UBound(rn1) '2° ciclo scorre la colonna A
    If rn1(x, 1) = p Then 'confronta la sigla colonna A con la sigla dell'estrazione
      Cells(x + 1, 2) = n 'ogni volta che la trova scrive il numero in colonna B
    End If
  Next x
Next y
'chiusura seleziona la cella A1 e rispristina lo schermo e il calcolo delle formule
'riportando il tempo impiegato
Cells(1, 1).Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Fine = Timer
MsgBox ("Tempo impiegato " & Round((Fine - Inizio), 2) & " secondi")
End Sub


ti allego anche 2 funzioni che ti saranno molto utili, le userai come Formule come se fosse una funzione normale.

sono il "Fuori90()" e "Vert90()", esempio nel tuo foglio che usi questa formula

=SE(RESTO(B2+D2;90);RESTO(B2+D2;90);90)

la sostituisci con

=Fuori90(B2+D2)

oppure il vertibile con del 61 che è il Fuori90 di prima

=Vert90(B2+D2) che è uguale a 16

queste le 2 funzioni, basta copiarle in un modulo e dimenticarle, poi applicare la funzione

Function Fuori90(ff) 'questa la funzione per il fuori90

While ff > 90
    ff = ff - 90
Wend
If ff = 0 Then ff = 90
Fuori90 = ff
End Function

Function Vert90(n) 'questa per i vertibili con il fuori90
Dim vv
While n > 90
    n = n - 90
Wend
If n = 0 Then n = 90
vv = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 1, 19, 21, 31, 41, 51, 61, 71, 81, 11, 2, 12, 29, 32, 42, 52, 62, 72, 82, 22, 3 _
            , 13, 23, 39, 43, 53, 63, 73, 83, 33, 4, 14, 24, 34, 49, 54, 64, 74, 84, 44, 5, 15, 25, 35, 45, 59, 65, 75, 85, 55 _
            , 6, 16, 26, 36, 46, 56, 69, 76, 86, 66, 7, 17, 27, 37, 47, 57, 67, 79, 87, 77, 8, 18, 28, 38, 48, 58, 68, 78, 89 _
            , 88, 9)
Vert90 = vv(n - 1)
End Function


allego anche il file.

Ciao By Sal (8-D
[Edited by by sal 10/25/2021 8:46 AM]
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 11
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/25/2021 4:58 PM
 
Modify
 
Delete
 
Quote

ok
cosi posso imparare a leggerle

grazie
Post: 6,568
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
10/25/2021 5:43 PM
 
Modify
 
Delete
 
Quote

Ciao se ti piace il VBA, allora incomincia ad imparare l'uso dell'editor, quello da imparare sono solo alcuni comandi, i principali sono 3

F5 fa partire la macro
F9 mette un punto di interruzione
F8 scorre la macro riga per riga

ce ne sono altri, ma questi sono necessari per vedere il funzionamento della macro, rilevare gli errori e correggerli nel caso ce ne sia bisogno

procedi piano piano.

le macro hanno un inizio ed una fine, iniziano con

Sub NomeMacro()

finiscono con

End Sub

tutto quello che si trova in mezzo sono i codici per il funzionamento

metti il cursore sulla riga Sub NomeMacro() e premi F9

vedrai la riga cambiare colore di norma Marrone con scritte bianche, premendo ancora F9 ritorna Normale

questo comporta un punto di blocco, cioè quando lanci la macro si fermerà in quel punto, quindi puoi decidere tu mettendo più punti di blocco quale parte della macro deve essere eseguita

adesso con il blocco posizionato su Sub NomeMacro() premi F5

questo farà partire la macro, ma logicamente si fermerà sulla prima riga diventando gialla, il cambio di colore Giallo significa che verrà eseguita l'istruzione di quella riga, per farla eseguire a questo punto premi F8

vedrai spostarsi la riga gialla alla riga successiva di comando, la riga delle variabile la legge ma non si ferma passa alla riga successiva.

a questo punto premendo ripetutamente F8 esegui la macro riga per riga controllando mano a mano cosa succede sul foglio per vedere se funziona bene oppure ci sono errori di esecuzione.

quando è attivo ScreenUpdating = false tali cambiamenti non li noti perche è bloccata la variazione del foglio, se devi fare i controlli devi disattivare ScreenUpdating con l'apostrofo.

ma oltre questo puoi vedere anche il valore che ha preso la variabile che hai assegnato, passando con il cursore sopra la variabile.

si può anche tornare indietro nella macro e rifare un passaggio modificando le istruzioni, per fare questo basta selesuonare sul bordo della riga gialla compare una frecci e puoi spostarla in avanti oppure indietro secondo quello che ti serve

ti metto una immagine per farti vedere il procedimento, nell'esecuzione della macro sopra.



con un poco di pratica potrai vedere come funzionano le macro ed acquisire più conoscenza.

Ciao By Sal (8-D
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 17
Registered in: 10/22/2021
Location: ACCIANO
Age: 53
Junior User
office 2010
OFFLINE
10/27/2021 9:31 PM
 
Modify
 
Delete
 
Quote

ciao
ho applicato ed adattato la macro di dodo47
ed era tutto ok

ora mi da un errore che prima non accadeva !

quando premo tasto prel 5/6 addendi
mi si blocca dicendo >>> tipo non corrispondente !

le ho provate tutte ma non capisco xche ora non funziona piu

la logica e uguale
cioe cercare la sigla di col Q in col J
prelev il corrispondente numero da inserire in col R

ma ora si blocca !

vi allego il file


NB
ho tentato anche di usare la macro di sal
ma non ho tradotto giusto qualcosa


[TESTO ::vba Sub RicPos() 'ricerca Posizione Dim r, c, d, p, n, x, y, rn1, rn2, arr1, Fine As Double, Inizio As Double Application.Calculation = xlCalculationManual 'blocca le formule r = Cells(Rows.Count, 17).End(xlUp).Row 'ultima riga colonna q Range("r2:r" & r).ClearContents 'pulisce dati in colonna r rn1 = Range("q2:q" & r) 'prende tutti i dati della colonna q Application.ScreenUpdating = False 'blocca lo scermo Inizio = Timer 'inizializza cronometro arr1 = Range("j2:j56") 'prende le sigle delle ruote r = Cells(Rows.Count, 9).End(xlUp).Row 'ultima riga colonna H rn2 = Range("I1:I" & r) 'prende estrazione colonna H For y = 1 To UBound(rn2) '1° ciclo scorre i numeri dell'estrazione n = rn2(y, 1) 'numero dell'estrazione p = arr1(y, 1) 'sigla dell'estrazione "Ba1-2-3-etc" Array colonna j For x = 1 To UBound(rn1) '2° ciclo scorre la colonna A If rn1(x, 17) = p Then 'confronta la sigla colonna q con la sigla dell'estrazione Cells(x + 1, 18) = n 'ogni volta che la trova scrive il numero in colonna r End If Next x Next y 'chiusura seleziona la cella A1 e rispristina lo schermo e il calcolo delle formule 'riportando il tempo impiegato Cells(1, 1).Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Fine = Timer MsgBox ("Tempo impiegato " & Round((Fine - Inizio), 2) & " secondi") End Sub]

ciao



[Edited by raimea 10/27/2021 9:49 PM]
Admin Thread: | Close | Move | Delete | Modify | Email Notification Previous page | 1 | Next page
New Thread
 | 
Reply
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Users | Search | Log In | Register | Admin
Tutti gli orari sono GMT+01:00. Adesso sono le 7:52 PM. : Printable | Mobile | Regolamento | Privacy
FreeForumZone [v.6.0] - Copyright © 2000-2021 FFZ srl - www.freeforumzone.com