Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

cerca codice e numero

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

cerca codice e numero

Postdi raimea » 01/11/21 09:49

ciao
tramite la macro >> Riporta5addendi
Codice: Seleziona tutto
Sub Riporta5addendi()  'ricerca Posizione
'----------------------
'
'--------------------------


Dim ur As Long, rp As String, rt As String, ps As Integer, rng As Range, riga As Integer

  scelta = MsgBox(Prompt:=" Vuoi importare gli addendi ? ", Buttons:=vbYesNo, _
Title:=" Importo 5/6 Addendi ")
If scelta = 6 Then          '6 = SI; 7=No    istruzioni per cancellare = SI
'------------------------------------------

Worksheets("ritardatari").Unprotect

Application.ScreenUpdating = False ' non vedo cambiare i vari fogli

inizio = Timer

'----------------------------------------------

ur = Range("q" & Rows.Count).End(xlUp).Row

Set rng = Range("J1:J51")
Application.Calculation = xlCalculationManual

For j = 2 To ur

    rp = Cells(j, 17)
    rt = Left(rp, 2)  ' sx
    ps = Right(rp, 1) ' dx  <<< si blocca qui
   
    riga = Application.WorksheetFunction.Match(rt, rng, 0)
    For I = riga To riga + 4
   
        If Cells(I, 8) = ps Then
            Cells(j, 18) = Cells(I, 9)  ' 18 col dove scrive  9 col dove cerca
            Exit For
        End If
    Next I
Next j

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True ' riattivo

fine = Timer

MsgBox ("Tempo impiegato " & Round((fine - inizio), 2) & " secondi")

End If   'Qui continua senza aver cancellato

Application.ScreenUpdating = True ' riattivo

'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True

 Range("v1").Select

End Sub



cerco i codici di col Q in col J
e riporto il relativo numero di col I


ES:
GE1 deve cercare il cod GE in col J
e il primo numero in col i (56)
quando lo trovo lo scrivo in col R

la macro funziona MA
saltuariamente "random", mi va in errore !
dopo aver cercato, e riportato l 'ultimo codice.

l 'errore che da e' >> tipo non corrispondente

https://www.dropbox.com/s/kskpttu9bihwny8/blocco1.jpg?dl=0

https://www.dropbox.com/s/idglzhcxsymrlyv/blocco_2.jpg?dl=0

non riesco capire xche e quando da tale errore

vi allego file
( che ora pare funzionare ! )

https://www.dropbox.com/scl/fi/racezatwgt9ay07m06s8c/riporta_numeri.xlsm?dl=0&rlkey=i5ol6ofkepx94ite0anjey4pd

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1343
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: cerca codice e numero

Postdi Anthony47 » 01/11/21 16:07

La cosa piu' probabile che mi immagino e' che in colonna Q qualche voce termini con un carattere non numerico, magari uno spazio poco visibile.
Quando va in errore ispeziona la cella J,17 (cioe' colonna "Q" riga j) e controllane il contenuto. Operando dall'editor delle macro puoi anche ispezionare il valore della variabile rp (vedi viewtopic.php?f=26&t=103893&p=647677#p647677 punto C, Controllo del contenuto di singole variabili)
Se questo e' il problema allora sarebbe meglio intervenire nel processo che compila la colonna Q, oppure puoi agire nella Sub Riporta5addendi "trimmando" eventuali spazi:
Codice: Seleziona tutto
    rp = Trim(Cells(j, 17))          '<<< MODIFICATO


Io per prudenza modificherei anche l'istruzione che ora va in errore:
Codice: Seleziona tutto
    ps = CInt(Right(rp, 1)) ' dx  <<< MODIFICATA
(solo per pulizia)

E se così non risolvi vedremo meglio

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

Re: cerca codice e numero

Postdi raimea » 01/11/21 17:14

ciao
trovato cosa causa l'errore

>> uno spazio in Col Q

solo che inserendo le 2 istruzioni sopra riportate
con lo spazio l errore si presenta ancora

Codice: Seleziona tutto
Sub Riporta5addendi()  'ricerca Posizione
'----------------------
'
'--------------------------


Dim ur As Long, rp As String, rt As String, ps As Integer, rng As Range, riga As Integer

  scelta = MsgBox(Prompt:=" Vuoi importare gli addendi ? ", Buttons:=vbYesNo, _
Title:=" Importo 5/6 Addendi ")
If scelta = 6 Then          '6 = SI; 7=No    istruzioni per cancellare = SI
'------------------------------------------

Worksheets("ritardatari").Unprotect

Application.ScreenUpdating = False ' non vedo cambiare i vari fogli

inizio = Timer

'----------------------------------------------

ur = Range("q" & Rows.Count).End(xlUp).Row

Set rng = Range("J1:J51")
Application.Calculation = xlCalculationManual

For j = 2 To ur

    'rp = Cells(j, 17)
    rp = Trim(Cells(j, 17))          '<<< MODIFICATO
   
    rt = Left(rp, 2)  ' sx
   
   
    'ps = Right(rp, 1) ' dx  <<< si blocca qui
    ps = CInt(Right(rp, 1)) ' dx  <<< MODIFICATA
   
   
    riga = Application.WorksheetFunction.Match(rt, rng, 0)
    For I = riga To riga + 4
   
        If Cells(I, 8) = ps Then
            Cells(j, 18) = Cells(I, 9)  ' 18 col dove scrive  9 col dove cerca
            Exit For
        End If
    Next I
Next j

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True ' riattivo

fine = Timer

MsgBox ("Tempo impiegato " & Round((fine - inizio), 2) & " secondi")

End If   'Qui continua senza aver cancellato

Application.ScreenUpdating = True ' riattivo

'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True

 Range("v1").Select

End Sub
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1343
Iscritto il: 11/02/10 07:33
Località: lago

Re: cerca codice e numero

Postdi Anthony47 » 02/11/21 10:46

Evidentemente non e' uno "spazio".
Se i dati li prelevi da un sito allora e' un "non-breaking space"(nbsp); invece di Trim usiamo Replace:
Codice: Seleziona tutto
    rp = Replace(Replace(Cells(j, 17), Chr(32), "", , , vbTextCompare), Chr(160), "", , , vbTextCompare)

Questa elimina sia gli Spazio, chr(32), che i nbsp, chr(160)

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 18195
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca codice e numero

Postdi raimea » 02/11/21 18:24

ciao

confermo che la causa sono " uno spazio"
( i dati non vengono prelevati da internet )

anche con
Codice: Seleziona tutto
 rp = Replace(Replace(Cells(j, 17), Chr(32), "", , , vbTextCompare), Chr(160), "", , , vbTextCompare)


si blocca ma non avevo specificato dove .... c'e lo spazio :roll:

il problema si crea quando accidentalmente si mette uno spazio in una cella di Col Q

ma sotto alle caselle popolate

ad Esempio
metto accidentalmente uno spazio in cella Q10

ho risolto mettendo questo:
Codice: Seleziona tutto
Range("q8:q1000").ClearContents


ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1343
Iscritto il: 11/02/10 07:33
Località: lago


Torna a Applicazioni Office Windows


Topic correlati a "cerca codice e numero":


Chi c’è in linea

Visitano il forum: Nessuno e 16 ospiti

cron