Nomi in codice

Hai un problema con Excel?

Nomi in codice di Alberto

Riscrivo il post, dopo la segnalazione di errore di sistema di apoben. un complimento per il sito che scopro ogni giorno più interessante. forse qualcuno può aiutarmi a risolvere questo problema. ho una lista di 30 nominativi ad ognuno dei quali ho associato un codice numerico che va, appunto dall'1 al 30.
vorrei che alla richiesta del numero di codice fatta da una msgbox e dopo che l'utente l'ha inserito, la procedura scrivesse su un foglio excel il nominativo ad esso corrispondente. in pratica la procedura dovrebbe funzionare così:
un messaggio chiede il numero di codice dell'interessato, l'utente lo inserisce, la procedura scrive, diciamo nella cella a1 del foglio2 excel, il nome corrispondente. fatto ciò, nuova richiesta del codice, inserimento, e scrittura da parte della procedura del nominativo corrispondente nella cella a2 del solito foglio, e così via. ringrazio sin d'ora chi mi volessa aiutare . -- alberto

di Enzo

Prova questo codice
dovrebbe funzionare
bye

Sub Trova_Codice()
Application.ScreenUpdating = False
XXX = InputBox("INSERIRE CODICE")
For I = 1 To 60000
Range("A" & I).Select
If ActiveCell.Text = XXX Then
Range("B" & I).Select
Selection.Copy
Sheets("Foglio2").Select
Range("A1").Select
Do
ActiveCell.Offset(1).Select
Loop Until ActiveCell.Value = ""
ActiveSheet.Paste
Range("A1").Select
If ActiveCell.Value = "" Then
Selection.Delete Shift:=xlUp
End If
Sheets("Foglio1").Select
Application.CutCopyMode = False
End
End If
If ActiveCell.Text = "" Then
MsgBox ("CODICE NON TROVATO")
End
End If
Next I
Application.ScreenUpdating = True
End Sub

di Enzo

Mi ero dimenticato
la procedura chiede tramite una inputbox un codice
va nel foglio1 dove nella colonna a controlla il codice se e' esistente
se lo trova prende il relativo nome posto a fianco nella colonna b e lo copia nella prima colonna a disponibile nel foglio2
se non trova nulla o trova una cella vuota si blocca e ti avvisa con una msgbox che non trova nulla

Per alberto di Apoben64

Ho visto che enzo mi ha battuto sul tempo e ne sono contento !. complimenti enzo . da parte mia ho allegato un file nella sezione scambio files e questo è relativo codice .

Sub cerca()
Dim Cl
Dim x As String
x = InputBox("INSERIRE CODICE")
Sheets("Foglio1").Select
For Each Cl In Range("A1:A100")
If Cl = x Then
Cl.Select
Cl.Offset(0, 1).Select
Selection.Copy
Sheets("Foglio2").Select
Cells(1, 1).End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
Application.CutCopyMode = False
Sheets("Foglio1").Select
Cells(1, 1).Select
End Sub

di Big ronnie

Ciao alberto,
quarda anche questo codice se ti piace.se dovesse cambiare il numero dei codici si aggiorna automaticamente.

Sub Codice()
Dim X As Integer: Dim I As Integer
X = CInt(InputBox("Inserisci il Codice", "Inserimento CODICE"))
I = 1
Do While Worksheets("Foglio1").Range("A" & I) <> ""
  I = I + 1
Loop
For I = 1 To I - 1
  If Worksheets("Foglio1").Range("A" & I) = X Then
     Worksheets("Foglio2").Range("a1").CurrentRegion.Select
     If Worksheets("Foglio2").Range("a1") = "" Then
        Selection.Offset(0, 0) = Worksheets("Foglio1").Range("B" & I)
        Else
        Selection.Offset(1, 0) = Worksheets("Foglio1").Range("B" & I)
        End If
        Exit Sub
    End If
Next I
MsgBox "CODICE INESISTENTE"
End Sub

di Alberto

Un caloroso ringraziamento al team enzo/luca/big ronnie.
per enzo.- il codice funzione perfettamente, dopo averlo inserito nel modulo1.
una curiosità. se accanto al nome (che compare nel foglio2) volessi aggiungere, nella cella a fianco anche il numero di codice che ho appena immesso, come dovrei modificare la routine?
e' possibile poi, ordinare questi nominativi, (man mano che la procedura li scrive), per ordine alfabetico o per numero di codice crescente?
per luca e big ronnie.- provando i vostri codici, non capisco perchè, ottengo una segnalazione di errore 400 oppure errore run time. eppure li ho trascritti con copia-incolla come ho già fatto per la procedura di enzo.
un enorme grazie anche ad entrambi voi.
alberto.-

di Enzo

Eccoti accontentato:
inserisce nel foglio 2 accanto al nome anche il relativo codice e in questo caso poi riordina in base al nome in modo crescente
per ordinare invece in modo crescente in base al codice bastera' in serire b1 invece che a1 nel codice
selection.sort key1:=range("a1"),
fammi sapere se e' tutto ok

Application.ScreenUpdating = False
XXX = InputBox("INSERIRE CODICE")
For I = 1 To 60000
Range("A" & I).Select
If ActiveCell.Text = XXX Then
Range("B" & I).Select
Selection.Copy
Sheets("Foglio2").Select
Range("A1").Select
Do
ActiveCell.Offset(1).Select
Loop Until ActiveCell.Value = ""
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = XXX
Range("A1").Select
If ActiveCell.Value = "" Then
Range("A1:B1").Select
Selection.Delete Shift:=xlUp
End If
 Columns("A:B").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheets("Foglio1").Select
Application.CutCopyMode = False
End
End If
If ActiveCell.Text = "" Then
MsgBox ("CODICE NON TROVATO")
End
End If
Next I
Application.ScreenUpdating = True
End Sub

Chiarimenti ad una studentessa di Anna18

Per enzo: ho analizzato con interesse il codice che hai fornito ad alberto. puoi spiegarmi il significato e l'esatta funzione dell'istruzione:
application.screenupdating=false
application.screenupdating=true
grazie per questa lezione. ----anna18

Ciao ! di Apoben64

Sono contento che sei riuscito a soddisfare la tua richiesta, hai però potuto provare il file inserito nella sezione scambio files ? più che altro per testare questa novità e verificare il funzionamento della macro.
spero che questa buona abitudine di confrontarci anche con esempi pratici trovi il consenso di tutti quelli che vogliono vivere questa passione.
facci sapere !!!

Per laura di Enzo

E' solo per un fatto estetico
serve a non far effettuare durante l'effettuazione della macro il cosidetto "sfarfallio del monitor"
serve sopratutto per applicazioni piu' complesse
mi spiego meglio
ipotizza di voler copiare il testo contenuto nella cella a1 del foglio 1 nelle relative cella a1 di altri n.... fogli
noterai che durante l'esecuzione della macro vedi tutto quello che la macro ha registrato ed il cursore che va a destra e a sinitra
utilizzando application.screenupdatin etc
non vedi questi movimenti ma solo il risultato alla fine della macro
in ogni caso registrati una qualsiasi macro e in una versione utilizza questa funzione
vedrai la differenza
fammi sapere

qui sotto trovi un esempòio banalissimo con l'applicazione e senza

Ricerca dati di Nastassja

Hola!ho un probl...dovrei creare una macro su un foglio excel per ricercare dei dati registrati su diversi fogli. il primo foglio contiene delle colonne con codice, articolo e prezzo; le colonne del secondo invece contengono codice, quantità vendute e data. sul terzo foglio quindi, con la macro, devo poter ricercare l'articolo relativo al codice, la quantità venduta e il periodo, il tutto creando anche una useform. inoltre devo poter stampare il mio lavoro, creare dei grafici e costruire un archivio. thanks

di Enzo

Dovresti aprire una nuova discussione
mi permetto di dirti che porre una domanda su dei quesiti che non si riescono a sciogliere va bene ma qui si richiede proprio un propgrammino vero e proprio
prova a creare un qualcosa tu di iniziativa e poi ci si viene incontro cercando di risolvere dei problemi che si vengono a creare
tutto qui

X enzo di Anna18

Ciao enzo! innanzitutto mi chiamo anna e non laura. se fai così con tutte le ragazze...
scherzi a parte, mi hai fatto capire perfettamente il significato e l'uso di application.screenupdating.
quanto alla restante parte del codice, credo di riuscire ad afferrarlo fino ad activesheet.paste. da lì in poi, ho alcune difficoltà di comprensione. poichè il tuo codice mi sembra didatticamente interessante, vorrei essere in grado di capirlo fino in fondo. ad es. i tre end if a quali condizioni fanno riferimento?
cosa significa selection.delete shift:=xlup?
perchè a volte scrivi activecell.text altre invece activecell.value? il massimo sarebbe stato avere lo stesso codice in forma indentata, ma quasi non ho il coraggio di chiederlo. riesci a tradurmi in italiano,sia pure a grandi linee, ciò che sta facendo la tua procedura? a presto.
---anna .

di Enzo

Eccoti accontenata

Application.ScreenUpdating = False				
XXX = InputBox("INSERIRE CODICE")				messaggio dove inserire il codice da cercare
For I = 1 To 60000				cerca nelle celle a se trova il contenuto
Range("A" & I).Select				della msgbox
Application.ScreenUpdating = False				
XXX = InputBox("INSERIRE CODICE")				messaggio dove inserire il codice da cercare
For I = 1 To 60000				cerca nelle celle a se trova il contenuto
Range("A" & I).Select				della msgbox
If ActiveCell.Text = XXX Then				se lo trovi
Range("B" & I).Select				
Selection.Copy				copia il contenuto della cella a
Sheets("Foglio2").Select				vai nel foglio 2
Range("A1").Select				vai in a1
Do				scendi fino a trovare nella colonna a
ActiveCell.Offset(1).Select				la prima cella vuot
Loop Until ActiveCell.Value = ""				
ActiveSheet.Paste				incolla
ActiveCell.Offset(0, 1).Select				spostati di una cella a cestra
ActiveCell.Value = XXX				inserisci il codice inserito all'inizio nella cella
Range("A1").Select				vai in a1
If ActiveCell.Value = "" Then				se la casella e' vuota
Range("A1:B1").Select				evidenzia a1 e b1
Selection.Delete Shift:=xlUp				cancella le caselle e sposta le sottastanti in altop
End If				
 Columns("A:B").Select				riordina le caselle in base al valore nella colonna a
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _				
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom				
Sheets("Foglio1").Select				
Application.CutCopyMode = False				
End				
End If				
If ActiveCell.Text = "" Then				se non trova nessun codice nella colonna a
MsgBox ("CODICE NON TROVATO")				msgbox con contenuto codice non trovato
End				
End If				
Next I				
Application.ScreenUpdating = True
End Sub

Vuoi approfondire questo argomento?