Login Registrati
Stai vedendo 17 articoli - dal 26 a 42 (di 42 totali)
  • Autore
    Articoli
  • #35552 Score: 0 | Risposta

    vecchio frac
    Senior Moderator
      272 pts

      Propongo una piccola ottimizzazione del codice. 

      Nella proposta di PCM77 manca Option Explicit in testa al modulo, mi raccomando di inserirlo sempre.

       

      Option Explicit
      
      Sub AssQuartiere()
      Dim ce As Range
      Dim f As Range
      Dim s As String
      Dim ra As Range
      
          With Worksheets("toponomastica")
              Set ra = .Range("A2:A" & .Range("A2").End(xlDown).Row)
          End With
          
          For Each ce In ra
              s = Trim(ce)
              Set f = Worksheets("pazienti").Range("F:F").Find(s, LookIn:=xlValues, lookat:=xlPart)
              If Not f Is Nothing Then f.Offset(, 1) = s
          Next
          
          MsgBox "Fatto"
      End Sub
      #35555 Score: 0 | Risposta

      PMC77
      Partecipante
        18 pts

        @vecchio frac

        Le ottimizzazioni / migliorie del codice son sempre ben accette!

        Resta il fatto che se l'utente non conosce il linguaggio se un domani dovrà fare una modifica non saprà da che parte girarsi!

        Buona giornata

        Paolo

        #35565 Score: 0 | Risposta

        giulioc
        Partecipante

          Buongiorno scusatemi ancora del disturbo. La prima proposta di albatros funziona ma non scrive niente sulla cella, la seconda proposta funziona ma ne "pizzica"pochi ovvero su 6000 solo 15. Spero che ci sia una soluzione. Vi ringrazio ancora della vostra cortese attenzione.

          #35566 Score: 0 | Risposta

          vecchio frac
          Senior Moderator
            272 pts

            Ciao Giulio, ti chiedo se hai considerato l'idea di tenere separati i numeri civici e le informazioni su interni e scale rispetto al puro indirizzo (via, piazza ecc.) per poi utilizzare INDICE e CONFRONTA. Questo non coinvolge VBA anche se avere poi seimila formule ripetute potrebbe rallentare l'esecuzione e le performances.

            Se invece ti butti su VBA, dovresti porre attenzione al fatto che i codici proposti non fanno molti controlli sui range interessati e questi sono aspetti non secondari da considerare (per esempio, nel codice che ho proposto io poco sopra non devono esserci righe vuote nel foglio toponomastica all'interno dell'elenco indirizzi, nè formule nella colonna F del foglio pazienti.

            #35568 Score: 0 | Risposta

            giulioc
            Partecipante

              Buongiorno sono costretto a "buttarmi" sul VBA in quanto le righe da modificare sono oltre 6000 e giornalmente si inseriscono oltre 20 righe. Ti ringrazio della tua attenzione. Questa ricerca della via serve per l'azzonamento ovvero unire più utenti nello stesso quartiere per agevolare la visita domiciliare. 

              #35569 Score: 0 | Risposta

              vecchio frac
              Senior Moderator
                272 pts

                In realtà anch'io consiglio VBA. E' più flessibile e ti consente operazioni di inserimento e ricerca molto agevoli. Non aver timore di affrontare questo linguaggio perché alla fine per l'uso normale è abbastanza accessibile e la curva di apprendimento tutto sommato non così ripida. Dovrai però prendere confidenza con lo strumento e il suo editor di sviluppo, cui si accede premendo Alt-F11. 

                Se vogliamo ripartire sarà necessario che fornisci l'ultima versione del file o almeno uno scenario realistico di lavoro, con più di due righe su cui lavorare. Noi possiamo abbozzare il lavoro ma poi alla fine sei tu a sapere cosa ti serve davvero, e a realizzarlo.

                Mi piacerebbe sapere per esempio perché il codice proposto sopra ti pizzica solo 15 indirizzi su 6000: e questo si vede solo dall'esempio concreto.

                #35570 Score: 0 | Risposta

                giulioc
                Partecipante

                  Ti invio file spero che sia sufficiente.

                  Allegati:
                  You must be logged in to view attached files.
                  #35572 Score: 0 | Risposta

                  PMC77
                  Partecipante
                    18 pts

                    @giulioc

                    Scusa se te lo dico, ma se cambi i nomi ai fogli, modifichi la posizione delle colonne è impossibile che qualcosa possa continuare a funzionare!

                    Il foglio da cui prendere il nome del quartiere è "stradario"?

                    Il foglio su cui andarea ad inserire il nome del quartiere di riferimento è ??????

                    Grazie

                    Paolo

                    #35574 Score: 0 | Risposta

                    albatros54
                    Moderatore
                      89 pts

                      Allora:

                      ho  rinominate la colonna H del  foglio "pazienti" in "indirizzo" la colonna  I  in"Indirizzo" , nel codice che ti posto è una integrazione al codice che ti ho postato precedentemente.Ho inserito in questo file un foglio "Toponomastica" con tutti gli indirizzi.Ti posto il codice da inserire  nel VBA del foglio "pazienti".

                      Option Explicit
                      Private Sub Worksheet_Change(ByVal Target As Range)
                          Static i As Integer
                          Dim Shpazientiultimariga As Integer, Shanagraficoultimariga As Integer
                          Dim ShTOPONOMASTICAultimariga As Integer
                          Dim Shpazienti As Worksheet, ShTOPONOMASTICA As Worksheet
                          Dim Shanagrafico As Worksheet
                          Dim Rnganagrafico As Range
                          Dim strada As String, sToken As String, sret As String
                          Dim j As Integer
                          Dim cerca As Object
                          Set Shpazienti = Sheets("pazienti")
                          Set Shanagrafico = Sheets("anagrafico")
                          Set ShTOPONOMASTICA = Sheets("TOPONOMASTICA")
                          Shpazientiultimariga = Shpazienti.Cells(Rows.Count, 1).End(xlUp).Row
                          Shanagraficoultimariga = Shanagrafico.Cells(Rows.Count, 1).End(xlUp).Row
                          ShTOPONOMASTICAultimariga = ShTOPONOMASTICA.Cells(Rows.Count, 1).End(xlUp).Row
                      
                          If Intersect(Target, Range("a2:a" & Shpazientiultimariga)) Is Nothing Then Exit Sub
                      
                          Shanagrafico.Select
                      
                          Set Rnganagrafico = Shanagrafico.Range("a2:a" & Shanagraficoultimariga).Find(Target)
                          If Rnganagrafico Is Nothing Then
                              MsgBox "non esiste"
                      
                              Shanagrafico.Cells(Shanagraficoultimariga + 1, 1) = Target
                      
                      
                          Else
                      
                      
                              ' MsgBox Rnganagrafico.Address
                              Shpazienti.Select
                              '
                      
                              strada = Shpazienti.Range(Target.Address).Offset(, 7)
                              For j = 1 To Len(strada)
                                  sToken = Mid(strada, j, 1)
                                  If Not IsNumeric(sToken) Then
                                      sret = sret & sToken
                                  Else
                                      Exit For
                                  End If
                              Next
                      
                              Set cerca = ShTOPONOMASTICA.Range("A2:A" & ShTOPONOMASTICAultimariga).Find(Trim(sret))
                              If cerca Is Nothing Then
                                  MsgBox "non esiste"
                              Else
                                  'MsgBox cerca.Address
                                  Shpazienti.Range(Target.Address).Offset(0, 8) = cerca.Offset(0, 1)
                              End If
                          End If
                      
                      
                      End Sub
                      

                      ti allego anche il file dove ho inserito il codice.

                      Ciao

                       

                      Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                      Sempre il mare, uomo libero, amerai!
                      ( Charles Baudelaire )
                      Allegati:
                      You must be logged in to view attached files.
                      #35577 Score: 0 | Risposta

                      giulioc
                      Partecipante

                        Vi ringrazio ma non posso mettere un   Worksheet_Change ne ho già uno che è fondamentale. Scusatemi 

                        #35578 Score: 0 | Risposta

                        albatros54
                        Moderatore
                          89 pts

                          devi solo sostituire il vecchio codice con quello che ti ho postato    vedi il file allegato che contiene anche il codice del foglio "pazienti"

                           

                          Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                          Sempre il mare, uomo libero, amerai!
                          ( Charles Baudelaire )
                          #35579 Score: 0 | Risposta

                          giulioc
                          Partecipante

                            ok grazie dei preziosi consigli

                            #35580 Score: 0 | Risposta

                            PMC77
                            Partecipante
                              18 pts

                              @albatros54 e @giulioc

                              Io non riesco bene a capire una cosa che secondo me è fondamentale per il funzionamento; è necessario che all'inserimento di un nuovo paziente/anagrafica venga subito assegnato anche il quartiere oppure è una procedura che tu puoi lanciare giornalmente/settimanalmente e ti va ad aggiornare tutto il foglio pazienti/anagrafica?

                              Se fosse la seconda, direi che puoi tranquillamente sfruttare la macro che ti ho inviato io adattando semplicemente i nomi dei fogli e i nomi delle colonne!

                              Ciao

                              Paolo

                              #35581 Score: 0 | Risposta

                              giulioc
                              Partecipante

                                Buongiorno se fosse possibile si! Inserire immediatamente il quartiere anche perché il giorno dopo lo vado a vedere a casa. Siete veramente gentili e non so come ringraziarvi.

                                #35582 Score: 0 | Risposta

                                albatros54
                                Moderatore
                                  89 pts

                                  Allora vediamo se possiamo cavare il buco dal ragno.

                                  Ho scaricato il file che hai postanel #35570(spero che si avvicini molto al file originale), nel foglio"Anagrafico" tu dovresti avere tutti i record  dei pazienti, il tuo problema è che vorresti avere alla colonna  "F" (che io ho rinominato "Quartieri" inserendo una colonna prima della colonna "Telefono") i quartieri che corrispondono alla vie dei vari pazienti, che vanno pescati nel foglio "Stradario", ma siccome i tuoi pazienti, che gia hai inserito sono circa 6000 è un lavorone inserirlia mano.

                                  Bene , ti posto questa macro, che puoi inserire in un modulo, la lanci  solamente una volta e ti compilera i campi quartiere del foglio "pazienti".

                                  N.B. la macro deve confrontare 6000 campi, quindi impieghera del tempo , se vuoi bloccare la macro per controllare i risultati CTRL+ BREAK(Pausa), dopo la puoi riprendere.

                                  Vedi se ho capito il tuo problema, se va bene poi andiamo avanti.

                                  Sub AssQuartiereAlbatros()
                                      Dim strada As String, sToken As String, sret As String
                                      Dim j As Integer
                                      Dim cerca As Object
                                      conta = Application.WorksheetFunction.CountA(Sheets("anagrafico").Range("E:E"))
                                      Set rng = Sheets("anagrafico").Range("E2:E" & conta)
                                      For Each cl In rng
                                          For j = 1 To Len(cl)
                                              sToken = Mid(cl, j, 1)
                                              If Not IsNumeric(sToken) Then
                                                  sret = sret & sToken
                                              Else
                                                  Exit For
                                              End If
                                          Next
                                  
                                  
                                          Set cerca = Sheets("stradario").Range("A2:A615").Find(Trim(sret))
                                          If cerca Is Nothing Then
                                              'MsgBox "non esiste"
                                          Else
                                              'MsgBox cerca.Address
                                              Sheets("anagrafico").Range(cl.Address).Offset(0, 1) = cerca.Offset(0, 1)
                                          End If
                                          sret = ""
                                      Next
                                  End Sub
                                  
                                  Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                                  Sempre il mare, uomo libero, amerai!
                                  ( Charles Baudelaire )
                                  Allegati:
                                  You must be logged in to view attached files.
                                  #35584 Score: 0 | Risposta

                                  giulioc

                                    Funziona ma solo per poche righe, sfrutta la memoria al massimo, il mio computer da 16 giga ha sofferto pensa un po i pc della asl che ne hanno 512.

                                    #35585 Score: 0 | Risposta

                                    albatros54
                                    Moderatore
                                      89 pts

                                      ascolta funziona per tutte le righe solo che sarà molto lento, mail lavoro che deve fare lo fa solo una volta,perchè quando tu andrai ad inserire un nuovo record controllera solo quello.

                                       

                                      Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
                                      Sempre il mare, uomo libero, amerai!
                                      ( Charles Baudelaire )
                                    Login Registrati
                                    Stai vedendo 17 articoli - dal 26 a 42 (di 42 totali)
                                    Rispondi a: cercare un indirizzo
                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                    Le tue informazioni: