Quote Originariamente inviata da sixdas Visualizza il messaggio
Ciao, grazie per l'esempio, il tuo codice fa proprio quello che volevo io. Adesso vorrei adattarlo per le mie esigenze e vorrei farti qualche domanda.

1) Posso ripetere quel pezzo di codice per ogni campo che voglio modificare, oppure ci sono problemi?
2) Visto che ho devo salvare anche testo libero e non solo date, con cosa devo modificare IsDate?

Grazie ancora.
Sì, sostanzialmente devi ripetere il codice per ogni campo però con qualche accortezza.

Nel'esempio che segue ho immaginando che oltre al campo data ci sia anche un campo numerico e uno alfanumerico che ho chiamato campo_num e campo_alfanum con i corrispondenti campi del db campo_num_db e campo alfanum_db ed inoltre ho tolto un po' di Value inutili e ho cambiato il nome della cella E15 da data_db a data_ritiro_db per uniformità con gli altri.

Nota che le righe precedute da un apice servono per commentare il codice e non vengono eseguite quindi puoi aggiungerne quante te ne pare per descrivere quello che viene fatto in ogni punto.

Devi poi indicare il corretto offset per ogni campo, il 5 è corretto per la data perché la data si trova 5 posizioni a destra rispetto al codice cliente, per campo_num e campo_alfanum ho messo un 6 e 7 di fantasia, devi adeguarli a quelli veri semplicemente contando le colonne a partire dal codice cliente.
Occhio che se in futuro aggiungerai colonne al database dovrai aggiornare gli offset perché excel non lo fa in automatico.


codice:
Private Sub Worksheet_Change(ByVal Target As Range)

' Prima IF. Non va ripetuta ma vanno ripetuti i campi da pulire

   If Not Intersect(Target, Range("cod_cliente")) Is Nothing Then
      Range("data_ritiro") = ""
      Range("campo_num") = ""
      Range("campo_alfanum") = ""
   End If

' Seconda If. Questa va ripetuta per ogni campo

' Campo data
   If Not Intersect(Target, Range("data_ritiro")) Is Nothing And _
      Range("data_ritiro") <> "" And _
      Not IsError(Range("data_ritiro_db")) _
   Then
      If Range("data_ritiro_db") = "00.00.00" And _
         Range("cod_cliente") <> "" And _
         IsDate(Range("data_ritiro")) _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 5) = Range("data_ritiro")
               Range("data_ritiro") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If

' Campo numerico
   If Not Intersect(Target, Range("campo_num")) Is Nothing And _
      Range("campo_num") <> "" And _
      Not IsError(Range("campo_num_db")) _
   Then
      If Range("campo_num_db") = 0 And _
         Range("cod_cliente") <> "" And _
         IsNumeric(Range("campo_num")) _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 6) = Range("campo_num")
               Range("campo_num") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If

' Campo alfanumerico
   If Not Intersect(Target, Range("campo_alfanum")) Is Nothing And _
      Range("campo_alfanum") <> "" And _
      Not IsError(Range("campo_alfanum_db")) _
   Then
      If Trim(Range("campo_alfanum_db")) = 0 And _
         Range("cod_cliente") <> "" _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 7) = Range("campo_alfanum")
               Range("campo_alfanum") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If

End Sub
Prima di provarlo però devo dirti ancora alcune cose.

Ho visto che c'è un malfunzionamento perché il formato data attribuito alla casella data_ritiro trasforma automaticamente i numeri in date e così questi passano il test isDate e vengono inserite date sbagliate nel db.
Prova, ad esempio, a scrivere 555 e vedi che succede.
Per risolvere devi dare il formato Generale alla casella e lo stesso dovrai fare per tutti i campi gialli da digitare.

Un altro malfunzionamento si ha sui campi alfanumerici perché la cerca.vert assegna il valore zero alla cella in caso di assenza di valore sul db, questo lo puoi superare dando alla cella campo_alfanum_db il formato personalizzato # (cancelletto).
A livello di codice questo problema obbliga a fare i test dei campi alfanumerici su 0 invece di "" come sarebbe più logico ma va bene così, non ci si può far nulla per quanto ne so.

Come avrai visto ogni volta che apri un foglio con macro devi ricordarti di attivarle ma puoi superare questa cosa inserendo il foglio in una cartella e poi dicendo a excel di attivare automaticamente le macro per tutti i fogli contenuti in quella cartella, così non te lo chiede ogni volta. Si fa dalle Opzioni --> Centro protezione --> Impostazioni --> Percorsi attendibili

Visto che i campi sono molti puoi migliorare il funzionamento attivando la casella gialla solo per i campi per i quali è necessario inserire il dato in modo che non si faccia confusione con tutte quelle caselle gialle inutili sempre visibili.

Per farlo devi dare un nome anche alla casella affianco alla casella gialla, la B17, tanto per capirci, per esempio data_ritiro_msg o campo_num_msg o campo_alfanum_msg e poi usare questo codice:

codice:
Private Sub Worksheet_Change(ByVal Target As Range)

' Prima IF. Non va ripetuta ma vanno ripetute le istruzioni di pulizia di ogni campo

   If Not Intersect(Target, Range("cod_cliente")) Is Nothing Then
      
' Pulizia di data ritiro
      Range("data_ritiro") = ""
      If Range("data_ritiro_db") = "00.00.00" Then
         Range("data_ritiro").Interior.Color = vbYellow
         Range("data_ritiro_msg") = "Inserisci Data ritiro"
      Else
         Range("data_ritiro").Interior.ColorIndex = xlColorIndexNone
         Range("data_ritiro_msg") = ""
      End If
      
' Pulizia di campo num
      Range("campo_num") = ""
      If Range("campo_num_db") = 0 Then
         Range("campo_num").Interior.Color = vbYellow
         Range("campo_num_msg") = "Inserisci Campo num"
      Else
         Range("campo_num").Interior.ColorIndex = xlColorIndexNone
         Range("campo_num_msg") = ""
      End If
      
' Pulizia di campo alfanum
      Range("campo_alfanum") = ""
      If Range("campo_alfanum_db") = 0 Then
         Range("campo_alfanum").Interior.Color = vbYellow
         Range("campo_alfanum_msg") = "Inserisci Campo alfanum"
      Else
         Range("campo_alfanum").Interior.ColorIndex = xlColorIndexNone
         Range("campo_alfanum_msg") = ""
      End If
   End If

' Seconda If. Questa va ripetuta per ogni campo

' Campo data
   If Not Intersect(Target, Range("data_ritiro")) Is Nothing And _
      Range("data_ritiro") <> "" And _
      Not IsError(Range("data_ritiro_db")) _
   Then
      If Range("data_ritiro_db") = "00.00.00" And _
         Range("cod_cliente") <> "" And _
         IsDate(Range("data_ritiro")) _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 5) = Range("data_ritiro")
               Range("data_ritiro") = ""
               Range("data_ritiro").Interior.ColorIndex = xlColorIndexNone
               Range("data_ritiro_msg") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If

' Campo numerico
   If Not Intersect(Target, Range("campo_num")) Is Nothing And _
      Range("campo_num") <> "" And _
      Not IsError(Range("campo_num_db")) _
   Then
      If Range("campo_num_db") = 0 And _
         Range("cod_cliente") <> "" And _
         IsNumeric(Range("campo_num")) _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 6) = Range("campo_num")
               Range("campo_num") = ""
               Range("campo_num").Interior.ColorIndex = xlColorIndexNone
               Range("campo_num_msg") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If

' Campo alfanumerico
   If Not Intersect(Target, Range("campo_alfanum")) Is Nothing And _
      Range("campo_alfanum") <> "" And _
      Not IsError(Range("campo_alfanum_db")) _
   Then
      If Trim(Range("campo_alfanum_db")) = 0 And _
         Range("cod_cliente") <> "" _
      Then
         For Each cliente In Sheets("Databse").Range("A:A")
            If CStr(cliente) = CStr(Range("cod_cliente")) Then
               cliente.Offset(0, 7) = Range("campo_alfanum")
               Range("campo_alfanum") = ""
               Range("campo_alfanum").Interior.ColorIndex = xlColorIndexNone
               Range("campo_alfanum_msg") = ""
               Exit For
            Else
               If cliente = "" Then
                  Exit For
               End If
            End If
         Next
      End If
   End If
   
End Sub
Non ho fatto test molto approfonditi quindi se qualcosa non funziona scrivi pure che lo mettiamo a posto.