Inserimento dato in riga sbagliata

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao  a tutti, ho questo codice 

 

Private Sub cmdInvia_Click()

    Dim contatore As String
    Dim rigaDebitore As Variant
    
If cboRicerca <> "" Then
MsgBox "Attenzione ! Record duplice", vbCritical, "Alert"
Call cmdReset_Click
    Exit Sub
    
    ActiveSheet.Cells(2, 2) = TxtCliente.Text
    
End If


  ' Seleziona la cella D2 e copia il suo contenuto (formula)
  Range("D2").Copy

  ' Incolla il contenuto nella cella immediatamente sopra (D2)
  Range("D2").PasteSpecial Paste:=xlPasteFormulas ' Incolla solo la formula
  ' Oppure usa Range("D2").PasteSpecial Paste:=xlPasteAll per incollare tutto (formula+formattazione)
  
  
  ' Rimuove la selezione "formica" (copia attiva)
  Application.CutCopyMode = False



contatore = TxtContatore.Value

If contatore = "" Then
MsgBox "Inserire Contatore", vbExclamation, "Alert"
TxtContatore.SetFocus
Exit Sub

ElseIf TxtCliente = "" Then
MsgBox "Inserire nome debitore", vbExclamation, "Alert"
TxtCliente.SetFocus
Exit Sub

ElseIf TxtMandato = "" Then
MsgBox "Inserire codice mandato", vbExclamation, "Alert"
TxtMandato.SetFocus
Exit Sub


ElseIf TxtDataOper = "" Then
MsgBox "Inserire data operazione", vbExclamation, "Alert"
TxtDataOper.SetFocus
Exit Sub


ElseIf TxtScadPag = "" Then
MsgBox "Inserire scadenza di pagamento", vbExclamation, "Alert"
TxtScadPag.SetFocus
Exit Sub

ElseIf TxtDebOrigin = "" Then
MsgBox "Inserire debito originario", vbExclamation, "Alert"
TxtDebOrigin.SetFocus
Exit Sub

ElseIf TxtAccord = "" Then
MsgBox "Inserire importo accordato", vbExclamation, "Alert"
TxtAccord.SetFocus
Exit Sub

ElseIf CboNumRate = "" Then
MsgBox "Inserire il numero di rate accordate", vbExclamation, "Alert"
CboNumRate.SetFocus
Exit Sub

ElseIf TxtDaPag = "" Then
MsgBox "Inserire importo da pagare", vbExclamation, "Alert"
TxtDaPag.SetFocus
Exit Sub

ElseIf TxtDirLiber = False Then
MsgBox "Inserire se ha diritto alla liberatoria ", vbExclamation, "Alert"
TxtDirLiber.SetFocus
Exit Sub

ElseIf TxtModalPag = False Then
MsgBox "Inserire modalità di pagamento concordata ", vbExclamation, "Alert"
TxtModalPag.SetFocus
Exit Sub


Else

ActiveSheet.Range("A999999").End(xlUp).Offset(1).Select
ActiveCell.Value = CDbl(TxtContatore)
ActiveCell.Offset(0, 1).Value = TxtCliente
ActiveCell.Offset(0, 2).Value = CDate(TxtDataOper)

ActiveCell.Offset(0, 4).Value = TxtMandato.Value
ActiveCell.Offset(0, 5).Value = CDate(TxtScadPag)
ActiveCell.Offset(0, 7).Value = CDbl(TxtDebOrigin)
ActiveCell.Offset(0, 8).Value = CDbl(TxtAccord)
ActiveCell.Offset(0, 9).Value = CDbl(CboNumRate)
ActiveCell.Offset(0, 11).Value = CDbl(TxtDaPag)


    If ChkSiPag = True Then
    ActiveCell.Offset(0, 12).Value = "Si"
    Else
    ActiveCell.Offset(0, 12).Value = "No"
    End If

    If ChkSiContab = True Then
    ActiveCell.Offset(0, 14).Value = "Si"
    Else
    ActiveCell.Offset(0, 14).Value = "No"
    End If
    
 
  If TxtDirLiber = S Then
    ActiveCell.Offset(0, 15).Value = "Si"
    Else
    ActiveCell.Offset(0, 15).Value = "No"
    End If
    
      ActiveCell.Offset(0, 16).Value = "No"
        
    
      If TxtModalPag = 1 Then
    ActiveCell.Offset(0, 18).Value = "Bonif"
    
    ElseIf TxtModalPag = 2 Then
    ActiveCell.Offset(0, 18).Value = "B_post"
    
    ElseIf TxtModalPag = 3 Then
    ActiveCell.Offset(0, 18).Value = "QrCode"
    
    Else
    ActiveCell.Offset(0, 18).Value = "null"
    End If
    

    
    

Call cmdReset_Click
End If
MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso"

Range("A2:R100").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

On Error Resume Next
rigaDebitore = Application.Match(CDbl(contatore), ActiveSheet.Range("A:A"), 0)
On Error GoTo 0

If Not IsError(rigaDebitore) Then
    Range("B" & rigaDebitore).Select
End If


End Sub

 

ma quando vado ad inserire tramite userform il dato che deve essere scritto nel foglio (0, 18 è il suo posizionamento), invece che scriverlo nella cella della nuova riga che vado a creare, me lo riporta nella colonna giusta ma all'ultima riga valorizzata del foglio stesso.

Dove sbaglio ?

[sgmmarBloccato sgmmar Karma: 5 pts]

ciao,

per esperienza personale e tranne in casi inequivocabili, è meglio non usare l'istruzione ActiveCell,

che è la cella attualmente selezionata e non sempre quella che si pensa sia attiva al momento del lancio della macro con qualsiasi modalità (evento foglio o pulsante ad uso dell'utente)

quindi.... in tutto il codice, sostituisci l'istruzione ActiveCell, con il riferimento specifico a cui applicare l'Offset(0,18)

 

buon lavoro

 

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao e grazie per il tuo consiglio, ma non ho capito che istruzione devo scrivere al posto di ActiveCell

Questo è ciò che attualmente è presente nel mio codice:

ActiveCell.Offset(0, 18).Value = "QrCode"

Qualora fosse utile, preciso il fatto che  offset 0, 18 corrisponde alla colonna "S".

Grazie mille

[alexps81Moderatore alexps81 Karma: 58 pts]

Frasubb ha scritto:

lo riporta nella colonna giusta ma all'ultima riga valorizzata del foglio stesso

Ma cosa significa questo che hai detto? Dove deve comparire il dato? Per com'è attualmente scritto il tuo codice, tutti i dati vengono trascritti nella prima riga libera di colonna "A"

Frasubb ha scritto:

non ho capito che istruzione devo scrivere al posto di ActiveCell

Dunque per intenderci tu scrivi:

ActiveSheet.Range("A999999").End(xlUp).Offset(1).Select

cioè tradotto "partendo dal fondo del foglio attivo, calcola l'ultima cella compilata in colonna A e seleziona la cella subito sotto"

Questo modo non serve. Al contrario ti basta semplicemente calcolare la prima cella vuota in colonna "A":

Dim ur As Long

ur = Cells(Rows.Count, "A").End(xlUp).Row + 1

Adesso sostituisci tutti gli ActiveCell con:

Cells(ur, "A").Value = CDbl(TxtContatore)
Cells(ur, "B").Value = TxtCliente
Cells(ur, "C").Value = CDate(TxtDataOper)
'......
'......
'......
'e così per gli altri controlli

Invece per questa parte:

    If TxtModalPag = 1 Then
    ActiveCell.Offset(0, 18).Value = "Bonif"
    
    ElseIf TxtModalPag = 2 Then
    ActiveCell.Offset(0, 18).Value = "B_post"
    
    ElseIf TxtModalPag = 3 Then
    ActiveCell.Offset(0, 18).Value = "QrCode"
    
    Else
    ActiveCell.Offset(0, 18).Value = "null"
    End If

utilizza il Select Case che è più bello anche da vedere:

Select Case TxtModalPag
    Case 1
        Cells(ur, "S").Value = "Bonif"
    Case 2
        Cells(ur, "S").Value = "B_post"
    Case 3
        Cells(ur, "S").Value = "QrCode"
    Case Else
        Cells(ur, "S").Value = "null"
End Select

Ovviamente queste sono considerazioni solo perché alla struttura del tuo codice ormai gli hai dato questa impostazione ma ovviamente sarebbe da riscriverlo decisamente meglio di così.

Ad ogni modo spiega meglio il problema che lamenti...magari apporta le modifiche così come ti ho suggerito e poi pubblica il file e spiega bene il problema.

[sgmmarBloccato sgmmar Karma: 5 pts]

Frasubb ha scritto:

Ciao e grazie per il tuo consiglio, ma non ho capito che istruzione devo scrivere al posto di ActiveCell

sei nelle migliori mani di qualsiasi Amministratore e/o Moderatore e/o Utente/ del Forum,

accogli ogni suggerimento dovesse arrivare

 

buona fortuna

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao Alex,

ho fatto come da te suggerito, ma funziona male.

Allego file esempio che ho compilato per prova e lasciato come mi viene restituito subito dopo la conferma che do col pulsante "Inserisci" della userform.

Come è evidente nel foglio, gli errori sono quelli in verde fluo, che dovrebbero essere scritti nella riga 3 che ho creato tramite user (nominativo CAIO), rispettivamente nelle colonne "O" e "P" per quanto riguarda i "NO", e nella colonna "S" (riga 3 e non l'ultima valorizzata) per quanto concerne "B_Post"

Dove ho sbagliato ?

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Frasubb ha scritto:

Dove ho sbagliato ?

Continui ad utilizzare ActiveCell!!!

    If ChkSiPag = True Then
    ActiveCell.Offset(0, 12).Value = "Si"
    Else
    ActiveCell.Offset(0, 12).Value = "No"
    End If

    If ChkSiContab = True Then
    ActiveCell.Offset(0, 14).Value = "Si"
    Else
    ActiveCell.Offset(0, 14).Value = "No"
    End If
    
 
  If TxtDirLiber = S Then
    ActiveCell.Offset(0, 15).Value = "Si"
    Else
    ActiveCell.Offset(0, 15).Value = "No"
    End If
    
      ActiveCell.Offset(0, 16).Value = "No"

[TheTrusterPartecipante TheTruster]

Frasubb ha scritto: 

Private Sub cmdInvia_Click()

    Dim contatore As String
    Dim rigaDebitore As Variant
    
If cboRicerca <> "" Then
MsgBox "Attenzione ! Record duplice", vbCritical, "Alert"
Call cmdReset_Click
    Exit Sub
    
    ActiveSheet.Cells(2, 2) = TxtCliente.Text
    
End If
​

A parte tutto il resto del codice, che come ti hanno detto è decisamente da rivedere,

Nutro forti dubbi sul fatto che la riga 

ActiveSheet.Cells(2, 2) = TxtCliente.Text

venga mai eseguita, visto che sta dopo un Exit Sub.

Inoltre concordo con gli altri che ActiveCell sia eccessivamente aleatorio.

Capisco che sia possibile che la cella giusta sia selezionata dopo 

ActiveSheet.Range("A999999").End(xlUp).Offset(1).Select

Ma non ne hai la certezza, quindi ti conviene seguire il consiglio di alexps81, oppure usa una variabile di tipo Range:

Dim xCell As Range
Set xCell = ActiveSheet.Range("A999999").End(xlUp).Offset(1)

xCell.Offset(0, 1).Value = "Quello che vuoi"

TheTruster

[FrasubbPartecipante Frasubb Karma: 1 pt]

grazie a tutti per i vostri consigli ma ho risolto in parte, ovvero non mi scrive il dato della colonna S nella riga appena creata ma nell'ultima valorizzata. Ho adottato i consigli di Alex, allego codice riveduto e corretto.

Forse ho saltato qualche correzione ?

Private Sub cmdInvia_Click()

    Dim contatore As String
    Dim rigaDebitore As Variant
    
If cboRicerca <> "" Then
MsgBox "Attenzione ! Record duplice", vbCritical, "Alert"
Call cmdReset_Click
    
    ActiveSheet.Cells(2, 2) = TxtCliente.Text
    Exit Sub
    
End If


  ' Seleziona la cella D2 e copia il suo contenuto (formula)
  Range("D2").Copy

  ' Incolla il contenuto nella cella immediatamente sopra (D2)
  Range("D2").PasteSpecial Paste:=xlPasteFormulas ' Incolla solo la formula
  ' Oppure usa Range("D2").PasteSpecial Paste:=xlPasteAll per incollare tutto (formula+formattazione)
  
  
  ' Rimuove la selezione "formica" (copia attiva)
  Application.CutCopyMode = False



contatore = TxtContatore.Value

If contatore = "" Then
MsgBox "Inserire Contatore", vbExclamation, "Alert"
TxtContatore.SetFocus
Exit Sub

ElseIf TxtCliente = "" Then
MsgBox "Inserire nome debitore", vbExclamation, "Alert"
TxtCliente.SetFocus
Exit Sub

ElseIf TxtMandato = "" Then
MsgBox "Inserire codice mandato", vbExclamation, "Alert"
TxtMandato.SetFocus
Exit Sub


ElseIf TxtDataOper = "" Then
MsgBox "Inserire data operazione", vbExclamation, "Alert"
TxtDataOper.SetFocus
Exit Sub


ElseIf TxtScadPag = "" Then
MsgBox "Inserire scadenza di pagamento", vbExclamation, "Alert"
TxtScadPag.SetFocus
Exit Sub

ElseIf TxtDebOrigin = "" Then
MsgBox "Inserire debito originario", vbExclamation, "Alert"
TxtDebOrigin.SetFocus
Exit Sub

ElseIf TxtAccord = "" Then
MsgBox "Inserire importo accordato", vbExclamation, "Alert"
TxtAccord.SetFocus
Exit Sub

ElseIf CboNumRate = "" Then
MsgBox "Inserire il numero di rate accordate", vbExclamation, "Alert"
CboNumRate.SetFocus
Exit Sub

ElseIf TxtDaPag = "" Then
MsgBox "Inserire importo da pagare", vbExclamation, "Alert"
TxtDaPag.SetFocus
Exit Sub

ElseIf TxtDirLiber = False Then
MsgBox "Inserire se ha diritto alla liberatoria ", vbExclamation, "Alert"
TxtDirLiber.SetFocus
Exit Sub

ElseIf TxtModalPag = False Then
MsgBox "Inserire modalità di pagamento concordata ", vbExclamation, "Alert"
TxtModalPag.SetFocus
Exit Sub


Else

Dim ur As Long
ur = Cells(Rows.Count, "A").End(xlUp).Row + 1

Cells(ur, "A").Value = TxtContatore
Cells(ur, "B").Value = TxtCliente
Cells(ur, "C").Value = CDate(TxtDataOper)
Cells(ur, "E").Value = TxtMandato.Value
Cells(ur, "F").Value = TxtScadPag
Cells(ur, "H").Value = TxtDebOrigin.Value
Cells(ur, "I").Value = TxtAccord.Value
Cells(ur, "J").Value = CboNumRate.Value
Cells(ur, "L").Value = TxtDaPag.Value



    If ChkSiPag = True Then
    Cells(ur, "M").Value = "Si"
    Else
    Cells(ur, "M").Value = "No"
    End If

    If ChkSiContab = True Then
    Cells(ur, "O").Value = "Si"
    Else
    Cells(ur, "O").Value = "No"
    End If
    
 
  If TxtDirLiber = S Then
    Cells(ur, "P").Value = "Si"
    Else
    Cells(ur, "P").Value = "No"
    End If
    
      Cells(ur, "Q").Value = "No"
        
    
      Select Case TxtModalPag
    Case 1
        Cells(ur, "S").Value = "Bonif"
    Case 2
        Cells(ur, "S").Value = "B_post"
    Case 3
        Cells(ur, "S").Value = "QrCode"
    Case Else
        Cells(ur, "S").Value = "null"
End Select
    

    
    

Call cmdReset_Click
End If
MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso"

Range("A2:R100").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

On Error Resume Next
rigaDebitore = Application.Match(CDbl(contatore), ActiveSheet.Range("A:A"), 0)
On Error GoTo 0

If Not IsError(rigaDebitore) Then
    Range("B" & rigaDebitore).Select
End If


End Sub

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Il tuo codice ora diciamo che "gira" ma adesso devi sistemare questa parte:

Range("A2:R100").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

In pratica dopo l'inserimento, esegui un ordinamento del range ("A2:R100") ma tu hai aggiunto anche la colonna "S". Quindi si sposta tutto tranne i valori presenti in quella colonna. Ma dato che adesso hai calcolato con ur la nuova riga, puoi definire il Range  da ordinare sfruttando proprio questo dato. Quindi:

Range("A2:S" & ur).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

Poi ne approfitto per darti una altro consiglio...tutta la parte dedicata alla verifica di presenza valori in "TextBox" e "ComboBox" potresti sostituirla con una tecnica basata su poche righe di codice.

dopo Application.CutCopyMode = False aggiungi questo pezzo di codice:

Dim ctl As Control

'per ogni controllo nella UserForm
For Each ctl In Me.Controls
    'se il controllo è una TextBox o ComboBox allora...
    If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
        'ad esclusione della ComboBox cboRicerca...
        If ctl.Name <> "cboRicerca" Then
            If Trim(ctl.Value) = "" Then
                MsgBox "Inserire " & ctl.Tag, vbExclamation, "Alert"
                ctl.SetFocus
                Exit Sub
            End If
        End If
    End If
Next ctl

poi tutta la parte sotto composta da If...ElseIf...Exit Sub fino all'Else prima di Dim ur As Long la puoi cancellare.

Fatto questo, dedica qualche minuto e seleziona uno alla volta ogni "TextBox" e "ComboBox" che ti interessano e di fianco sulla sinistra cerca la Proprietà TAG. In ogni TAG ci scrivi quello che vuoi far comparire nel messaggio che ti avvisa della mancanza del dato inserito.

Quindi nel codice già hai MsgBox "Inserire " & ctl.Tag, vbExclamation, "Alert, quindi la scritta Inserire già è presente. Devi sono completare la frase in ogni TAG.

Per concludere cancella anche End If sotto a Call cmdReset_Click

Spero di averti dato dei buoni consigli.

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao Alex,

ti ringrazio particolarmente per i tuoi preziosissimi suggerimenti che ho subito adottato e che sono andati a migliorare e risolvere certamente la situazione precedente.

Mi viene però fuori un errore, e quindi non mi funziona l'automatismo (vedi schermata allegata) che seleziona la cella della colonna B della riga appena creata con la user.

Oltretutto, nella colonna F (Scad.), vicino alle date appena inserite, compare il triangolino verde con il messaggio "la cella contiene una stringa data rappresentata con solo due cifre per l'anno". E' possibile formattare automaticamente la data nel formato gg/mm/aa senza questo avviso ?

Grazie infinite e scusa il disturbo e l'ennesima richiesta d'aiuto

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Hai un po' di cose da sistemare. Però vorrei che ci arrivassi da solo in base ai consigli che ti do:

parti dal presupposto che tutto ciò che esce da una "TextBox" o "ComboBox" è una stringa. Quindi se tu scrivi nella "TextBox" 12345 in realtà non sta uscendo un numero ma un testo...quindi avrai "12345"

Puoi quindi dedurre che una data, arriverà in cella come testo, a quel punto ecco l'avviso che ti ritrovi.

Da quello che vedo, in colonna "A" tu inserisci un valore numerico. All'inizio dichiari una variabile chiamata contatore come stringa, poi la valorizzi con ciò che proviene da TxtContatore.Value ma anche se scrivi un valore numerico, dato che contatore l'hai definita come stringa, allora quel valore verrà memorizzato come testo.

Ora che hai capito il problema, devi dichiarare contatore come Long e non come String

Poi quando scrivi il numero del contatore in colonna "A", anziché utilizzare:

Cells(ur, "A").Value = TxtContatore

sfrutta la variabile, che racchiude finalmente un numero:

Cells(ur, "A").Value = contatore

Per le date devi fare un discorso diverso. Per la TxtDataOper hai utilizzato giustamente la Funzione CDate() per forzare la conversione in data, perché non hai provato a fare la stessa cosa per l'altra data (TxtScadPag)?

Attenzione...tu però vuoi che sia mostrato l'anno a 2 cifre. Qui devi sfruttare anche la Funzione Format():

Cells(ur, "C").Value = CDate(Format(TxtDataOper, "dd/mm/yy"))

Per la questione della selezione cella in colonna "B" dell'ultimo inserimento...be' qui il problema è sempre legato al tipo di dato che è scritto in cella e quello che si vuole cercare.

Qui: rigaDebitore = Application.Match(CDbl(contatore), ActiveSheet.Range("A:A"), 0)

con CDbl(contatore) stai convertendo in numero il valore contenuto in contatore ma perché prima contatore era una stringa. Ma siccome su tu hai inserito in colonna "A" il numero del contatore con TxtContatore.Value ti ritrovi un testo in "A".

Quindi stai cercando un numero in una colonna che ha valori scritti in testo. Dopo che hai fatto tutte le modifiche che ti ho suggerito, sostituisci in:

rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0)

quindi adesso cerchi un numero in una colonna con valori numerici.

Spero che ora tutto funzioni anche perché siamo andati molto fuori tema. Quindi le prossime richieste devono essere trattato in nuove discussioni   

[FrasubbPartecipante Frasubb Karma: 1 pt]

Ciao Alex (vorrei taggarti ma seppur scrivo prima del tuo nome "@" non mi funziona ... boohh),

grazie per i tuoi suggerimenti, sempre molto utili e di altissimo lignaggio !

Tutto ok tranne la cella A ovvero il contatore, in quanto se io inserisco il tutto tramite user, come vedi nel file allegato mi riporta un semplice 0 (zero) anziche il vero numero inserito nella textbox.

Eppure mi sembra di aver apportato le modifiche al codice correttamente come da tue indicazioni. Dove sbaglio ?

Grazie mille

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Hai dimenticato di calcolare la variabile contatore.

Aggiungi contatore = TxtContatore.Value prima del listato:

'>> qui valorizza la variabile "contatore"
Cells(ur, "A").Value = contatore
Cells(ur, "B").Value = TxtCliente
Cells(ur, "C").Value = CDate(Format(TxtDataOper, "dd/mm/yy"))
Cells(ur, "E").Value = TxtMandato.Value
Cells(ur, "F").Value = CDate(Format(TxtScadPag, "dd/mm/yy"))
Cells(ur, "H").Value = TxtDebOrigin.Value
Cells(ur, "I").Value = TxtAccord.Value
Cells(ur, "J").Value = CboNumRate.Value
Cells(ur, "L").Value = TxtDaPag.Value

[Autore]

Articoli