• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Gegevens uit Tabel in Userform importeren, aanvullen en weer wegschrijven

Status
Niet open voor verdere reacties.
L

lemonstreet25

Gebruiker
Lid geworden
27 sep 2016
Berichten
52
Excellisten,

In bijgaand vb bestand heb ik een userform gemaakt om waarden mee weg te schrijven naar een tabel. Ik heb niet een verplichting ingebouwd (bewust) om ALLE gegevens ineens te moeten opgeven. Dus moet het mogelijk zijn om later het record (row) weer te laden in de userform, aan te vullen en weer (in dezelfde rij van tabel) weg te schrijven. Vraag: welke code koppel ik aan de "aanvullen" Commandbutton in het userform? De bedoeling is om op basis van de waarde in Kolom A van de tabel (S-nummer in de vorm S123456789) de gegevens uit die rij weer te geven, aan te vullen waar nodig (of zelfs wijzigen) en weer in diezelfde rij weg te schrijven. Mijn poging tot nu toe:

Code: 
Private Sub CommandButton2_Click()
Dim Changerow As ListRow
        If Len(Trim(TextBox1.Value)) = 0 Then
            MsgBox ("Vul s-nummer in"), vbInformation
            Else: For Each cell In Range("tabel1").Column("S-nummer")
                If cell.Value = TextBox1.Text Then
                Changerow = cell.Row
                MsgBox Changerow
                End If
        End If
End Sub

Bekijk bijlage Invoerformulier BC sheet.xlsm
 
Ik heb er al wat aan gedaan ... niet alles natuurlijk
 

Bijlagen

  • Invoerformulier BC sheet RE.xlsm
    124,4 KB · Weergaven: 131
Geachte heer Nouws,

Dat is een wel hééél chique (nachtelijke) oplossing; en leert mij weer heel wat mogelijkheden. Probleem is dat de database (Tabel1) uit meerdere honderden records gaat bestaan en dus de keuzelijst die u heeft toegevoegd aan Userform heer erg groot gaat worden; en dus lastig om juiste record (op basis van S-nummer) te selecteren. Vandaar dat ik op basis van S-nummer als input in textbox1 de row wil laten bepalen waarin de data staat; en deze dan na aanvulling/wijziging weer weg wil schrijven op dezelfde row middels de aanvul "command_button2". Ik vermoed dat het wegschrijven mij gaat lukken; mijn probleem zit 'm in het laten vinden van de juiste row. Mogelijk dat u hier nog even naar kunt kijken?

Bij voorbaat dank,

Luc
 
En op deze manier
(zoek bv. op S125)
 

Bijlagen

  • Invoerformulier BC sheet RE.xlsm
    120,6 KB · Weergaven: 174
Geachte heer Nouws,
Beste Jack,

Mijn dank is zeer groot. Ik heb een hand gekregen waar ik om een (figuurlijke) vinger vroeg :) . Na bestudering van de code begin ik het licht te zien. Alleen wordt bij updaten de data niet correct weggeschreven; er worden kolommen door elkaar gehaald. Dat wil ik graag zelf corrigeren uiteraard; maar daarvoor zou ik het op prijs stellen als je een beetje kan uitleggen wat exact er gebeurt middels deze code; en dan vooral de "Private Sub CommandButton2_Click()". In het 2e gedeelte"Private Sub L1_Click()" wordt L1 gevuld met de waarden uit het Userform.

Code: 
Private Sub CommandButton2_Click()
    With Sheets("Data & Planning").ListObjects(1)
        .DataBodyRange.Columns(1).Find(TextBox1).Resize(, 21) = Array(TextBox1, TextBox2, ComboBox1.Value, TextBox4, _
         TextBox5, ComboBox3.Value, TextBox7, TextBox3, ComboBox2.Value, Frame1.Tag, TextBox11, , , , , , TextBox8, Frame2.Tag, Frame3.Tag, TextBox9, TextBox10)
        .Range.Sort .ListColumns(3), 1, , , , , , xlYes
    End With
      L1.List = Sheets("Data & Planning").ListObjects(1).DataBodyRange.Value
End Sub

Private Sub L1_Click()
    TextBox1 = L1.Column(0)
    TextBox2 = L1.Column(1)
    TextBox3 = L1.Column(7)
    TextBox4 = L1.Column(3)
    TextBox5 = L1.Column(4)
    TextBox7 = L1.Column(6)
    TextBox8 = L1.Column(16)
    TextBox9 = L1.Column(20)
    TextBox10 = L1.Column(21)
    TextBox11 = L1.Column(10)
    ComboBox1 = L1.Column(2)
    ComboBox2 = L1.Column(5)
    ComboBox3 = L1.Column(8)
    radJa = IIf(L1.Column(9) = "Y", True, False)
    Radnee = IIf(L1.Column(9) = "N", True, False)
    OptionButton1 = IIf(L1.Column(18) = OptionButton1.Caption, True, False)
    OptionButton2 = IIf(L1.Column(18) = OptionButton2.Caption, True, False)
    OptionButton3 = IIf(L1.Column(19) = OptionButton3.Caption, True, False)
    OptionButton4 = IIf(L1.Column(19) = OptionButton4.Caption, True, False)
    OptionButton5 = IIf(L1.Column(19) = OptionButton5.Caption, True, False)

End Sub

Nogmaals mijn dank voor de lessen!

Luc
 
Hoi,

Met
With Sheets("Data & Planning").ListObjects(1).DataBodyRange.Columns(1).Find(TextBox1)
​
Wordt in de eerste kolom van je tabel gezocht naar de waarde die in texbox1 staat.

Met
.Resize(, 21) = Array(TextBox1, TextBox2, ComboBox1.Value, TextBox4, etc
​
​
Hier wordt vanaf de gevonden rij de waarden van de array over 21 kolmmen vedeeld.
​

.Range.Sort .ListColumns(3), 1, , , , , , xlYes
​
3e Kolom van je tabel wordt gesorteert.

L1.List = Sheets("Data & Planning").ListObjects(1).DataBodyRange.Value
​
Listbox wordt opnieuw geladen

Private Sub L1_Click()
TextBox1 = L1.Column(0)
TextBox2 = L1.Column(1)
TextBox3 = L1.Column(7)
​
Als je op een item van je listbox klikt worden de gegevens vanuit je listbox naar je textboxen geschreven.​
 
Laatst bewerkt:
Jack, dank voor de uitleg. Ik ben weer vele stappen verder. Hoe kan ik een formattering meegeven aan de weg te schrijven data? De gegevens komen nu als tekst in de tabel terecht waardoor de formules die ik erop los laat niet meer werken; in het bijzonder de bedragen en de Data. Is het niet mogelijk de data op dezelfde wijze weg te schrijven als in sub command button_1?
 
Ja hoor dat kan. Vervang in de array bv. Textbox5 naar Textbox5.Value, dan wordt het niet meer als tekst geschreven.
 
Jack, dank weer! Nu wil ik checken of een S-nummer (Textbox1) reeds bestaat in kolom 1. Onderstaande code blijft foutmelding geven. Wat doe ik fout?

Code: 
Private Sub CommandButton1_Click()
        Dim NewRow As ListRow
        With Sheets("Data & Planning").ListObjects(1)
                 [COLOR="#00FF00"]If .DataBodyRange.Columns(1).Find(TextBox1) = False Then[/COLOR]
                        Set NewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
                        NewRow.Range.Cells(1, 1).Value = TextBox1.Value
                        NewRow.Range.Cells(1, 1).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 2).Value = TextBox2.Value
                        NewRow.Range.Cells(1, 2).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 8).Value = TextBox3.Value
                        NewRow.Range.Cells(1, 8).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 4).Value = TextBox4.Value
                        NewRow.Range.Cells(1, 4).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 5).Value = TextBox5.Value
                        NewRow.Range.Cells(1, 5).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 7).Value = TextBox7.Value
                        NewRow.Range.Cells(1, 7).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 17).Value = TextBox8.Value
                        NewRow.Range.Cells(1, 17).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 20).Value = TextBox9.Value
                        NewRow.Range.Cells(1, 20).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 21).Value = TextBox10.Value
                        NewRow.Range.Cells(1, 21).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 11).Value = TextBox11.Value
                        NewRow.Range.Cells(1, 11).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 3).Value = ComboBox1.Value
                        NewRow.Range.Cells(1, 3).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 9).Value = ComboBox2.Value
                        NewRow.Range.Cells(1, 9).HorizontalAlignment = xlRight
                        NewRow.Range.Cells(1, 6).Value = ComboBox3.Value
                        NewRow.Range.Cells(1, 6).HorizontalAlignment = xlRight
                        If radJa.Value = True Then
                        NewRow.Range.Cells(1, 10).Value = radJa.Caption
                        ElseIf Radnee.Value = True Then
                        NewRow.Range.Cells(1, 10).Value = Radnee.Caption
                        End If
                        If OptionButton1.Value = True Then
                        NewRow.Range.Cells(1, 18).Value = OptionButton1.Caption
                        ElseIf OptionButton2.Value = True Then
                        NewRow.Range.Cells(1, 18).Value = OptionButton2.Caption
                        End If
                        If OptionButton3.Value = True Then
                        NewRow.Range.Cells(1, 19).Value = OptionButton3.Caption
                        ElseIf OptionButton4.Value = True Then
                        NewRow.Range.Cells(1, 19).Value = OptionButton4.Caption
                        ElseIf OptionButton5.Value = True Then
                        NewRow.Range.Cells(1, 19).Value = OptionButton5.Caption
                        End If
                        Unload Me
                    Else
                        MsgBox "DUBBEL"
                    End If
            End With
        End Sub
 
Vervang je code en kijk eens of dit voor je werkt.
Code: 
Private Sub CommandButton1_Click()
    If WorksheetFunction.CountIf(Sheets("Data & Planning").Columns(1), TextBox1) > 0 Then
        MsgBox ("Dit S-nummer is reeds ingegeven, gebruik de knop" & vbNewLine & "[Aanvullen]" & _
                vbNewLine & "indien de gegevens moeten worden aangepast!"), vbCritical, "Fout!"
        CommandButton2.SetFocus
        Exit Sub
    End If
    
    If MsgBox("Correcte ingave?", vbYesNo + vbQuestion, "Kijk de gegevens na!") = vbNo Then Exit Sub
    With Sheets("Data & Planning").ListObjects(1)
        .DataBodyRange(.ListRows.Count + 1, 1).Resize(, 21) = Array(TextBox1, TextBox2, ComboBox1.Value, TextBox4, TextBox5.Value, ComboBox3.Value, _
         TextBox7.Value, TextBox3, ComboBox2.Value, Frame1.Tag, TextBox11.Value, , , , , , TextBox8, Frame2.Tag, Frame3.Tag, TextBox9, TextBox10)
        .Range.Sort .ListColumns(3), 1, , , , , , xlYes
        .Range.HorizontalAlignment = xlRight
    End With
    MsgBox "De nieuwe ingave is opgeslagen", vbInformation, "Klaar"
    
 Unload Me
End Sub
 
Wow, een alternatieve (kortere) programmeer optie. Gaaf! De data wordt nu alleen "buiten" de Tabel weggeschreven. Vermoedelijk omdat onderstaand nu weg is?

Code: 
Dim NewRow As ListRow
        With Sheets("Data & Planning").ListObjects(1)
        Set NewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)

en vervolgens de Array in de NewRow weg te schrijven.

Daarnaast, ik kan de kolom waarin gesorteerd wordt veranderen in:

Code: 
.Range.Sort .ListColumns([B]3[/B]), 1, , , , , , xlYes

Hoe kan ik aangeven in welke "volgorde" er gesorteerd moet worden? Bijvoorbeeld in Kolom "status": eerst Status1, dan Status3, dan Status 4 etc.
 
De 1 kun je in een 2 wijzigen voor op- of aflopend te sorteren.
Code: 
.Range.Sort .ListColumns([B]9[/B]), 1, , , , , , xlYes
Bij mij wordt alles netjes in de tabel geplaatst ipv er buiten.
Code: 
(.ListRows.Count + 1, 1)
En dit gebruik ik dus niet
Code: 
Dim NewRow As ListRow
        With Sheets("Data & Planning").ListObjects(1)
        Set NewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
 
Laatst bewerkt:
Jack, er zit een "fout" in Command_button 2 regels. Ik blijf een foutmelding houden en krijg die niet weg: Fout 13 tijdens uitvoering; typen komen niet overeen. En bij foutopsporing:

Code: 
Private Sub CommandButton2_Click()
    If TextBox12.Value = "" Then
        MsgBox ("Vul waarde in in zoekveld!")
        Exit Sub
    End If
        
        With Sheets("Data & Planning").ListObjects(1)
            .[U]DataBodyRange.Columns(1).Find(TextBox1).Resize(, 21) = Array(TextBox1.Value, TextBox2.Value, ComboBox1.Value, TextBox4.Value, _
             TextBox5.Value, ComboBox3.Value, Round(TextBox7.Value, 0), TextBox3.Value, ComboBox2.Value, Frame1.Tag, TextBox11.Value, , , , , , TextBox8.Value, _
             Frame2.Tag, Frame3.Tag, TextBox9.Value, TextBox10.Value)
            .Range.Sort .ListColumns(9), 2, , , , , , xlYes[/U]
        End With
          L1.List = Sheets("Data & Planning").ListObjects(1).DataBodyRange.Value
        Unload Me
End Sub

Bekijk bijlage Invoerformulier BC sheet v2.xlsm
 
Zowel de code achter commandbutton1 en commandbutton2 verlopen bij mij zonder foutmeldingen.
Dus ik heb geen idee wat er bij jou mis kan gaan.
 
Wat eigenaardig. bij mij blijft foutmelding komen: Even stap voor stap hetgeen ik doe:

Open Form (Traject toevoegen/bewerken)
In textbox12 (Zoekveld) "9478" invullen
Bij CRM waarde "100000" invullen/toevoegen
Command_button 2 selecteren.

Dan heb ik gelijk de foutmelding
 
Code: 
Round(TextBox7.Value, 0)
Geeft de foutmelding als er geen waarde is ingevuld.
 
Waarom is jouw onderliggende tabel compleet anders dan de invoervelden in het formulier. Maak ook gebruik van kolomkoppen die identiek zijn aan de labels in het formulier. Scheelt voor de helpers zoeken naar wat je waar weg wil schrijven/wijzigen.

Als je data al in een listbox hebt staan dan is find onnodig en kan je de listindex gebruiken.
Code: 
Private Sub CommandButton2_Click()
  Dim b
  If L1.ListIndex > -1 Then
    With Sheets("Data & Planning").ListObjects(1)
      If IsNumeric(TextBox7.Value) Then b = Round(TextBox7.Value, 0) Else b = b
      .DataBodyRange.Cells(L1.ListIndex + 1, 1).Resize(, 21) = Array(TextBox1.Value, TextBox2.Value, ComboBox1.Value, TextBox4.Value, _
      TextBox5.Value, ComboBox3.Value, b, TextBox3.Value, ComboBox2.Value, Frame1.Tag, TextBox11.Value, , , , , , TextBox8.Value, _
      Frame2.Tag, Frame3.Tag, TextBox9.Value, TextBox10.Value)
      .Range.Sort .ListColumns(9), 2, , , , , , xlYes
      End With
    L1.List = Sheets("Data & Planning").ListObjects(1).DataBodyRange.Value
  End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan