-
Articoli
-
Ciao a tutti,
nel mio file ho il seguente codice:
Private Sub cmdInvia_Click() Dim contatore As Long 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 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 Dim ur As Long ur = Cells(Rows.Count, "A").End(xlUp).Row + 2 contatore = TxtContatore.Value 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 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") = "Si" Else Cells(ur, "P") = "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 MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso" Range("A2:S" & ur).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo On Error Resume Next rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0) On Error GoTo 0 If Not IsError(rigaDebitore) Then Range("B" & rigaDebitore).Select End If End Sub.... funziona benissimo ma che, se possibile, vorrei modificare facendo si che mi venga generata la riga sopra, con tutti i dati inseriti dapprima tramite userform, e una riga subito sotto che riporti SOLO la data della colonna "F". Più semplicemente parlando, basterebbe generare una nuova riga vuota nella quale incollare esclusivamente il contenuto copiato dalla riga sopra, cella colonna "F".
In poche parole, ogni nuovo nominativo inserito deve generare due righe.
Allego file che dimostra come mi servirebbe.
Grazie in anticipo a chi vorrà aiutarmi !!!
@frasubb per come è adesso strutturato il tuo file, l'unica cosa che mi viene in mente adesso senza stravolgere nulla di particolare...sarebbe quella di fare un doppio trasferimento di dati dalla UserForm al Foglio...Sortare per colonna "B"...cancellare il contenuto di cella "B" (il cliente) della riga di sotto.
Quindi modifica così questo pezzo:
ur = Cells(Rows.Count, "F").End(xlUp).Row + 1 '<--facciamo il calcolo in base a colonna "F" adesso contatore = TxtContatore.Value Cells(ur, "A").Value = contatore Cells(ur, "B").Value = TxtCliente Cells(ur + 1, "B").Value = TxtCliente '<--duplichiamo il cliente 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 + 1, "F").Value = CDate(Format(TxtScadPag, "dd/mm/yy")) '<--duplichiamo la data Cells(ur, "H").Value = TxtDebOrigin.Value Cells(ur, "I").Value = TxtAccord.Value Cells(ur, "J").Value = CboNumRate.Value Cells(ur, "L").Value = TxtDaPag.Valuepoi modifica questa:
Range("A2:S" & ur + 1).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo '<--il Sort comprende anche la riga sottoed infine questa:
If Not IsError(rigaDebitore) Then Range("B" & rigaDebitore + 1).Value = "" '<--cancelliamo il contenuto della cella dell'utente scritto sotto Range("B" & rigaDebitore).Select End IfPrima di far funzionare la macro, devi aggiungere sotto ad ogni Nominativo presente in colonna "B" il nome di quello scritto alla riga sopra. Quindi sotto a PAPERINO ci scrivi PAPERINO, sotto a TOPOLINO ci scrivi TOPOLINO.
Poi prova le modifiche.
P.S. Siccome stai utilizzando VBA per questo progetto, puoi fare a meno delle Formule nelle varie colonne D; G; K; N e sfruttare le macro per tutti quei inserimenti. Ovviamente da trattare in altre discussioni.
@frasubb scusa ma ho detto una stupidaggine! Per farmi perdonare ti propongo un restyling al tuo codice...sarebbe ancora da migliorare eliminando quelle formule nelle varie colonne e far lavorare tutto tramite VBA...ma come ti dicevo se la cosa può interessarti la vediamo in altre discussioni, per poi finire di sistemare questo che ti propongo.
Dopo
Next ctlcancella tutto fino aEnd Sube sostituiscilo con questo:contatore = TxtContatore.Value Dim arr() As Variant Dim r As Long, c As Long, nRows As Long, nCols As Long, k As Long Dim temp1 As Variant nRows = Cells(Rows.Count, "F").End(xlUp).Row nCols = 19 ReDim arr(1 To (nRows + 1), 1 To nCols) As Variant For r = LBound(arr, 1) To nRows For c = LBound(arr, 2) To nCols arr(r, c) = Cells(r + 1, c).Value Next c Next r arr(nRows, 1) = contatore 'A arr(nRows, 2) = TxtCliente 'B arr(nRows, 3) = CDate(Format(TxtDataOper, "dd/mm/yy")) 'C arr(nRows, 5) = TxtMandato.Value 'E arr(nRows, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<-- da replicare arr(nRows, 8) = TxtDebOrigin.Value 'H arr(nRows, 9) = TxtAccord.Value 'I arr(nRows, 10) = CboNumRate.Value 'J arr(nRows, 12) = TxtDaPag.Value 'L If ChkSiPag = True Then arr(nRows, 13) = "Si" 'M Else arr(nRows, 13) = "No" End If If ChkSiContab = True Then arr(nRows, 15) = "Si" 'O Else arr(nRows, 15) = "No" End If If TxtDirLiber = "S" Then arr(nRows, 16) = "Si" 'P Else arr(nRows, 16) = "No" End If arr(nRows, 17) = "No" 'Q Select Case TxtModalPag 'S Case 1 arr(nRows, 19) = "Bonif" Case 2 arr(nRows, 19) = "B_post" Case 3 arr(nRows, 19) = "QrCode" Case Else arr(nRows, 19) = "null" End Select arr(nRows + 1, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<--replicato 'Bubble Sort For r = 1 To UBound(arr, 1) - 2 Step 2 For c = r + 2 To UBound(arr, 1) Step 2 If UCase(arr(c, 2)) < UCase(arr(r, 2)) Then ReDim temp1(1 To 2, 1 To UBound(arr, 2)) For k = 1 To UBound(arr, 2) temp1(1, k) = arr(r, k) Next k temp1(2, 6) = arr(r + 1, 6) For k = 1 To UBound(arr, 2) arr(r, k) = arr(c, k) Next k arr(r + 1, 6) = arr(c + 1, 6) For k = 1 To UBound(arr, 2) arr(c, k) = temp1(1, k) Next k arr(c + 1, 6) = temp1(2, 6) End If Next c Next r Application.EnableEvents = False Application.ScreenUpdating = False For r = LBound(arr, 1) To UBound(arr, 1) Cells(r + 1, "A").Value = arr(r, 1) Cells(r + 1, "B").Value = arr(r, 2) Cells(r + 1, "C").Value = arr(r, 3) Cells(r + 1, "E").Value = arr(r, 5) Cells(r + 1, "F").Value = arr(r, 6) Cells(r + 1, "H").Value = arr(r, 8) Cells(r + 1, "I").Value = arr(r, 9) Cells(r + 1, "J").Value = arr(r, 10) Cells(r + 1, "L").Value = arr(r, 12) Cells(r + 1, "M").Value = arr(r, 13) Cells(r + 1, "O").Value = arr(r, 15) Cells(r + 1, "P").Value = arr(r, 16) Cells(r + 1, "Q").Value = arr(r, 17) Cells(r + 1, "S").Value = arr(r, 19) Next r Application.EnableEvents = True Application.ScreenUpdating = True Call cmdReset_Click On Error Resume Next rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0) On Error GoTo 0 If Not IsError(rigaDebitore) Then Range("B" & rigaDebitore).Select End If MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso" End SubTi spiego cosa fa...
1) va a calcolare l'ultima riga compilata in colonna "F" (perché adesso le righe sono 2 per ogni cliente e in colonna "F" ci sarà l'unico dato della seconda riga)
2) predispone un Array a 2 dimensioni, dove la prima dimensione rappresenta le righe mentre la seconda le colonne. Per le righe ci saranno 2 righe in più rispetto a quante sono attualmente compilate sul Foglio, così da ospitare i dati provenienti dalla UserForm. Per le colonne ce ne saranno 19 così quante sono compilate sul Foglio
3) l'Array verrà compilato prelevando i dati dal foglio...poi in un secondo momento, nelle ultime 2 righe, verranno aggiunti i dati provenienti dalle TextBox e ComboBox della UserForm.
4) verrà quindi eseguito un Bubble Sort (ordinamento dei dati) in base al NOMINATIVO (colonna "B") ovvero lavorando sulla colonna 2 dell'Array.
5) dopo ordinato, verranno trasferiti i dati dall'Array al Foglio...compilandolo daccapo.
Quindi...lanci la macro per inserire i nuovi dati...prima preleva i dati dal foglio, poi accoda ad essi i dati delle TextBox e ComboBox, poi ordina il tutto ed infine ritrasferisce sul Foglio tutti i dati.
Ciao Alex,
doverosamente inizio dicendo che non solo non devi farti perdonare di niente, ma sei lodevole di qualunque menzione e plauso per le tue competenze in campo VBA, nonché per la pazienza che hai nel sopportarmi. Mi hai risolto un mare di problemi, quindi sono io che chiedo perdono a te !!!
Detto doverosamente ciò, ho apportato le correzioni che mi hai suggerito ed il tutto va da Dio, è perfetto.
Solo una cosa, e spero di spiegarmi: perché dopo che si chiude la user, se spingo un tasto funzione (es F9) per riaprirla, oppure il TAB, non funziona niente ma devo prima cliccare su una cella qualsiasi del foglio per tornare a farli funzionare ?
Scusa Alex,
in base a questa tua risposta
“1) va a calcolare l'ultima riga compilata in colonna "F" (perché adesso le righe sono 2 per ogni cliente e in colonna "F" ci sarà l'unico dato della seconda riga)”
si può inserire nella seconda riga, oltre che la data in colonna “F” come già fatto, il testo “pagamento” in colonna “D” (nominativo cliente) ?
Grazie mille
si può inserire nella seconda riga, oltre che la data in colonna “F” come già fatto, il testo “pagamento” in colonna “D” (nominativo cliente) ?
In colonna "D" vedo che come intestazione di colonna la scritta "Azienda cedente". Cosa vuoi dire con "nominativo cliente"?
Mi puoi fare un esempio pratico di come dovrebbero essere compilate le due righe in tutte le colonne?
Ciao Alex, questo si può inserire nella seconda riga, oltre che la data in colonna “F” come già fatto, il testo “pagamento” in colonna “D” (nominativo cliente) ? l'ho risolto ma ora non riesco a far quest'altra cosa:
nella seconda riga che vado a creare, dove già replico la data in colonna "F", avrei necessità di inserire, sempre tramite user, il codice fiscale ed il numero di telefono.
Ho provato con questo codice da me adattato, ma questi due nuovi dati me li scrive sopra alla nuova riga e non sotto.
Dove sbaglio ?
Allego codice e file esempio
` Private Sub cmdInvia_Click() Application.ScreenUpdating = False '<-- evita lo sfarfallìo del monitor Dim contatore As Long 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 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 contatore = TxtContatore.Value Dim arr() As Variant Dim r As Long, c As Long, nRows As Long, nCols As Long, k As Long Dim temp1 As Variant nRows = Cells(Rows.Count, "F").End(xlUp).Row nCols = 19 ReDim arr(1 To (nRows + 1), 1 To nCols) As Variant For r = LBound(arr, 1) To nRows For c = LBound(arr, 2) To nCols arr(r, c) = Cells(r + 1, c).Value Next c Next r arr(nRows, 1) = contatore 'A arr(nRows, 2) = TxtCliente 'B Cells(Rows + 1, "B") = TxtCodfisc ' L'HO INSERITA IO Cells(Rows + 1, "C") = TxtTelefono ' L'HO INSERITA IO arr(nRows, 3) = CDate(Format(TxtDataOper, "dd/mm/yy")) 'C arr(nRows, 5) = TxtMandato.Value 'E arr(nRows, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<-- da replicare arr(nRows, 8) = TxtDebOrigin.Value arr(nRows, 9) = TxtAccord.Value 'I arr(nRows, 10) = CboNumRate.Value 'J arr(nRows, 12) = TxtDaPag.Value 'L If ChkSiPag = True Then arr(nRows, 13) = "Si" 'M Else arr(nRows, 13) = "No" End If If ChkSiContab = True Then arr(nRows, 15) = "Si" 'O Else arr(nRows, 15) = "No" End If If TxtDirLiber = "S" Then arr(nRows, 16) = "Si" 'P Else arr(nRows, 16) = "No" End If arr(nRows, 17) = "No" 'Q Select Case TxtModalPag 'S Case 1 arr(nRows, 19) = "Bonif" Case 2 arr(nRows, 19) = "B_post" Case 3 arr(nRows, 19) = "QrCode" Case Else arr(nRows, 19) = "null" End Select arr(nRows + 1, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<--replicato 'Bubble Sort For r = 1 To UBound(arr, 1) - 2 Step 2 For c = r + 2 To UBound(arr, 1) Step 2 If UCase(arr(c, 2)) < UCase(arr(r, 2)) Then ReDim temp1(1 To 2, 1 To UBound(arr, 2)) For k = 1 To UBound(arr, 2) temp1(1, k) = arr(r, k) Next k temp1(2, 6) = arr(r + 1, 6) For k = 1 To UBound(arr, 2) arr(r, k) = arr(c, k) Next k arr(r + 1, 6) = arr(c + 1, 6) For k = 1 To UBound(arr, 2) arr(c, k) = temp1(1, k) Next k arr(c + 1, 6) = temp1(2, 6) End If Next c Next r Application.EnableEvents = False Application.ScreenUpdating = False For r = LBound(arr, 1) To UBound(arr, 1) Cells(r + 1, "A").Value = arr(r, 1) Cells(r + 1, "B").Value = arr(r, 2) Cells(r + 1, "C").Value = arr(r, 3) Cells(r + 1, "E").Value = arr(r, 5) Cells(r + 1, "F").Value = arr(r, 6) Cells(r + 1, "H").Value = arr(r, 8) Cells(r + 1, "I").Value = arr(r, 9) Cells(r + 1, "J").Value = arr(r, 10) Cells(r + 1, "L").Value = arr(r, 12) Cells(r + 1, "M").Value = arr(r, 13) Cells(r + 1, "O").Value = arr(r, 15) Cells(r + 1, "P").Value = arr(r, 16) Cells(r + 1, "Q").Value = arr(r, 17) Cells(r + 1, "S").Value = arr(r, 19) Next r Application.EnableEvents = True Application.ScreenUpdating = True Call cmdReset_Click On Error Resume Next rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0) On Error GoTo 0 If Not IsError(rigaDebitore) Then Range("B" & rigaDebitore).Select End If r = Range("H" & Rows.Count).End(xlUp).Row Range("H" & r + 1) = 1 * TextBox1 r = Range("I" & Rows.Count).End(xlUp).Row Range("I" & r + 1) = 1 * TextBox1 r = Range("L" & Rows.Count).End(xlUp).Row Range("L" & r + 1) = 1 * TextBox1 MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso" TxtDataOper.SetFocus End Sub`Ciao Alex, “resettando” tutti i discorsi precedenti altrimenti faccio solo confusione, chiedo solo se si riesce a scrivere nella doppia riga creata come da tuo codice suggerito, il codice fiscale in B e recapito telefonico in C.
Le altre discussioni dimmi te se le devo chiudere o eliminare, se puoi e ti va di aiutami (per l’ennesima volta!!) ad avere la soluzione, sempre per favore e quando sei comodo, a quanto appena sopra da me indicato.
Grazie mille
Allora @frasubb vediamo se così abbiamo risolto tutto (inserimento in doppia riga con Codice Fiscale, Nr. Telefono e Data + rimozione delle formule nelle varie celle, lavoriamo quindi solo con VBA)
Prendi in considerazione questo file che allego perché dal tuo ho rimosso manualmente tutte le formule. Fai inserimenti da zero e vedi come va.
Comunque nella tua macro sono presenti riferimenti a "CheckBox" che nella UserForm non esistono. Come mai? Ad esempio le ChkSiPag e ChkSiContab non esistono eppure ci fai un controllo su di esse:
If ChkSiPag = True Then arr(nRows, 13) = "Si" 'M Else arr(nRows, 13) = "No" End If If ChkSiContab = True Then arr(nRows, 15) = "Si" 'O Else arr(nRows, 15) = "No" End Ifmagari spiega meglio come mai ci sono questi due controlli.
Intanto prova il file allegato
Grande Alex sei un fenomeno, ma questo lo sai e te l'ho già detto !!
Grazie, è tutto perfetto !
Comunque nella tua macro sono presenti riferimenti a "CheckBox" che nella UserForm non esistono. Come mai? Ad esempio le ChkSiPag e ChkSiContab non esistono eppure ci fai un controllo su di esse:
Hai perfettamente ragione, le usavo prima ma poi nei vari cambiamenti che ho fatto, ho dimenticato di cancellarne i controlli dal codice, ora lo faccio.
Un'ultima cosa: perché subito dopo aver confermato l'inserimento dei dati tramite userform, ed averla chiusa, essendo quindi tornati sul foglio di lavoro, se pigio un tasto funzione associato ad una macro (es. F1 per riaprire la user) prima devo cliccare col mouse su una qualsiasi cella del foglio di lavoro stesso, altrimenti non mi funziona ?
se pigio un tasto funzione associato ad una macro (es. F1 per riaprire la user) prima devo cliccare col mouse su una qualsiasi cella del foglio di lavoro stesso, altrimenti non mi funziona ?
Però poi dopo questa ricordati di segnare come risolto e per le prossime richieste aprine altre!!
Nel Modulo4 devi invertire l'ordine. Prima imposti il Focus nella TxtDataOper e poi mostri la UserForm1
Login
Registrati
Stai vedendo 12 articoli - dal 1 a 12 (di 12 totali)
Stai vedendo 12 articoli - dal 1 a 12 (di 12 totali)