Nomi in codice

  • 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