[Risolto] ricerca e modifica record in userform

ciao

per ricevere gli avvisi devi cliccare su

sottoscrivi a nuove risposte che vedi sopra alla richiesta

per il resto se i vbaisti non intervengono

vedo cosa riesco a fare oggi.......sono lentissimo con il vba

@gianfranco55 ciao di  nuovo, sono riuscita ad ottenere un abbozzo di risultato ma la mia userform non funziona come dovrebbe e sono bloccata. Mi spiego meglio:

- nella listbox dovrebbero venire elencati data fattura, importo, data pagamento e metodo di pagamento ma in realtà vedo solo i numeri che corrispondono alle righe del record relative al fornitore richiesto

- le textbox successive sono totalmente sballate...la data non riporta una data, il metodo di pagamento risulta numerico e non testo eccetera

- la ricerca funziona solo se inserisco il nome fornitore esattamente come è scritto comprese maiuscole e minuscole...c'è modo di impostarla in maniera che funzioni anche se inserisco solo una parte della ragione sociale e senza essere case sensitive? 

Allego di nuovo il file modificato..si parla della userform1 relativa al foglio acquisti. Grazie in anticipo..

ciao

metti in crisi con il VBA

avverto Marius e se non interviene provo

ma devi avere pazienza ci metto una vita con il VBA

per le maiuscole e minuscole

basta scrivere sopra ai codici

Option Compare Text

Ciao @Cyberlady

esegui queste modifiche:

1. cancella la TextBox5 (quella della "ricerca") ed anche il relativo Pulsante
2. al suo posto, disegna una ComboBox nella proprietà del Name rinominala cboFornitore
3. rinomina la TextBox6 in TextBox5
4. cancella tutto il codice presente nella UserForm1 e sostituiscilo con il seguente:

   Option Explicit
   
   Dim rigoProg As Variant
   
   Private Sub UserForm_initialize()
       Dim ws As Worksheet
       Dim cell As Range, fornitori As Range
       Dim ur As Long
       Dim arrFornitori As Object
       Dim fornitore As String
       
       Set ws = ThisWorkbook.Sheets("acquisti")
       Set arrFornitori = CreateObject("System.Collections.ArrayList")
       
       ur = ws.Cells(Rows.Count, "E").End(xlUp).Row
       
       If ur > 2 Then
           Set fornitori = ws.Range("E3:E" & ur)
           For Each cell In fornitori
               fornitore = Trim(cell.Value)
               If Not arrFornitori.Contains(fornitore) Then
                   arrFornitori.Add fornitore
               End If
           Next cell
           arrFornitori.Sort
           cboFornitore.List = Application.Transpose(arrFornitori.ToArray)
       End If
           
       Set ws = Nothing
       Set cell = Nothing
       Set fornitori = Nothing
       Set arrFornitori = Nothing
   
   End Sub
   
   Private Sub cboFornitore_Change()
       caricaListaFornitore
   End Sub
   
   Sub caricaListaFornitore()
       Dim ws As Worksheet
       Dim f As Range
       Dim fornitore As String, firstAddress As String
       Dim i As Integer
       
       Set ws = ThisWorkbook.Sheets("acquisti")
       fornitore = cboFornitore.Value
       ListBox1.ColumnCount = 5
       ListBox1.ColumnWidths = "0pt; 70pt; 35pt; 60pt; 100pt"
       
       For i = 2 To 5
           Controls("TextBox" & i).Value = ""
       Next i
       
       Set f = ws.Range("E:E").Find(What:=fornitore, After:=ws.Range("E2"), LookIn:=xlValues, LookAt:=xlWhole)
       
       If Not f Is Nothing Then
           firstAddress = f.Address
           With ListBox1
               .Clear
               Do
                   .AddItem
                   .List(.ListCount - 1, 0) = ws.Cells(f.Row, "A").Value 'progressivo
                   .List(.ListCount - 1, 1) = ws.Cells(f.Row, "C").Value 'nr. fattura
                   .List(.ListCount - 1, 2) = Format(ws.Cells(f.Row, "G").Value, "#,##0.00 €") 'totale fattura
                   .List(.ListCount - 1, 3) = ws.Cells(f.Row, "O").Value 'data pagamento
                   .List(.ListCount - 1, 4) = ws.Cells(f.Row, "P").Value 'moldalità pagamento
           
                   Set f = ws.Range("E:E").FindNext(f)
               Loop While Not f Is Nothing And firstAddress <> f.Address
           End With
       End If
       
       rigoProg = 0
       
       Set ws = Nothing
       Set f = Nothing
   End Sub
   
   Private Sub ListBox1_Click()
       Dim ws As Worksheet
       Dim i As Integer
       Dim progressivo As Integer
       
       Set ws = ThisWorkbook.Sheets("acquisti")
       
       progressivo = ListBox1.List(ListBox1.ListIndex, 0)
       
       rigoProg = Application.Match(progressivo, ws.Range("A:A"), 0)
       
       If Not IsError(rigoProg) Then
           TextBox2.Value = Format(ws.Cells(rigoProg, "G").Value, "#,##0.00 €") 'totale fattura
           TextBox3.Value = ws.Cells(rigoProg, "O").Value 'data pagamento
           TextBox4.Value = ws.Cells(rigoProg, "P").Value 'modalità pagamento
           TextBox5.Value = ws.Cells(rigoProg, "D").Value 'data fattura
       End If
       
       Set ws = Nothing
   End Sub
   
   Private Sub btnModificaFattura_Click()
       Dim ws As Worksheet
       Dim i As Integer
       
       If rigoProg > 0 Then
           i = MsgBox("Vuoi modificare i dati della fattura selezionata?", vbQuestion + vbYesNo, "Modifica fattura")
           If i = vbNo Then Exit Sub
           
           Set ws = ThisWorkbook.Sheets("acquisti")
           
           ws.Cells(rigoProg, "G") = CDbl(TextBox2.Value)
           ws.Cells(rigoProg, "G").NumberFormat = "#,##0.00 €"
           ws.Cells(rigoProg, "O") = CDate(TextBox3.Value)
           ws.Cells(rigoProg, "P") = TextBox4.Value
           ws.Cells(rigoProg, "D") = CDate(TextBox5.Value)
           
           caricaListaFornitore
           MsgBox "Dati aggiornati correttamente!", vbInformation, "Modifica fattura"
       End If
       
       Set ws = Nothing
   End Sub

ciao

Alexps

bene arrivato e spero vederti rispondere spesso

io con il vba non ci vado d'accordo.......mi crea allergia 😀 

Ciao @gianfranco55, grazie 👍 

be' anche io con le Formule non ci vado affatto d'accordo...un giorno spero di impararle

@alexps81 grazie, ho provato ma mi restituisce un errore di runtime e un errore di automazione, non riesco a capire dove sia l'errore

Ciao, può essere che nel tuo PC non è disponibile l'oggetto ArrayList. Appena posso cambio approccio e ti giro il nuovo codice.

Nel frattempo allega di nuovo il file con le modifiche che ti ho indicato.

Ciao

@alexps81 grazie, allego il file

Ciao @Cyberlady

prova a sostituire il codice dell'evento UserForm_Initialize() con questo e fammi sapere se abbiamo risolto:

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim cell As Range, fornitori As Range
    Dim ur As Long, i As Integer, j As Integer
    Dim dictFornitori As Object
    Dim fornitore As String
    Dim arrFornitori() As Variant, tempArray As Variant
    
    Set ws = ThisWorkbook.Sheets("acquisti")
    Set dictFornitori = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(Rows.Count, "E").End(xlUp).Row
    
    If ur > 2 Then
        Set fornitori = ws.Range("E3:E" & ur)
        For Each cell In fornitori
            fornitore = Trim(cell.Value)
            If Not dictFornitori.Exists(fornitore) Then
                dictFornitori.Add fornitore, fornitore
            End If
        Next cell
        
        
        arrFornitori = dictFornitori.Items
        
        For i = LBound(arrFornitori) To UBound(arrFornitori) - 1
            For j = i + 1 To UBound(arrFornitori)
                If arrFornitori(i) > arrFornitori(j) Then
                    tempArray = arrFornitori(i)
                    arrFornitori(i) = arrFornitori(j)
                    arrFornitori(j) = tempArray
                End If
            Next j
        Next i
        
        cboFornitore.List = arrFornitori
    End If
        
    Set ws = Nothing
    Set cell = Nothing
    Set fornitori = Nothing
    Set dictFornitori = Nothing
End Sub

@alexps81 funziona alla perfezione, grazie davvero..non sarei mai riuscita a concepire un codice del genere ❤️

Grazie a te per il riscontro 🤗