cerca codice e numero

[raimea]

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

[Anthony47]

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

[raimea]

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


[Anthony47]

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...

[raimea]

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

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