invullen van liefhebber en dieren

[danny147]

Beste

Graag zou ik het aantal dieren willen wegschrijven via een invulformulier.

De bedoeling is dat persoonnr. aantal keren wordt ingevuld naar gelang het aantal dieren hij heeft.
Naast persoonnr moet het dier vermeld worden in afkorting Vb ko = konijnen
Komt het dier 5 x voor dan moet 5 x de afkorting naast persoonnr staan

Heb al een voorbeeld geplaatst in kolom B en C.

Zijn er nog vragen dan hoor ik het graag.

Groetjes Danny. :thumb:

 

[wampier]

zet dit in je formcode:

Option Explicit

Dim aantal(7) As Long
Dim dier(7) As String

Dim i As Integer

Private Sub CommandButton1_Click()
    Dim j As Integer
    Dim start As Range
    Set start = [b65000].End(xlUp).Offset(1, 0)
    For i = 0 To 6
        If (aantal(i)) Then
            For j = 1 To aantal(i)
                start = TextBox1.Text
                start.Offset(0, 1) = dier(i)
                Set start = start.Offset(1, 0)
            Next j
        End If
    Next i
    
End Sub

Private Sub CommandButton2_Click()
    For i = 0 To 6
        aantal(i) = 0
    Next i
    Call TextBox2_Change
    Call TextBox3_Change
    Call TextBox4_Change
    Call TextBox5_Change
    Call TextBox6_Change
    Call TextBox7_Change
    Call TextBox8_Change
    
End Sub

Private Sub TextBox2_Change()
    aantal(0) = Val(TextBox2.Text)
    TextBox2.Text = aantal(0)
End Sub

Private Sub TextBox3_Change()
    aantal(1) = Val(TextBox3.Text)
    TextBox3.Text = aantal(1)
End Sub

Private Sub TextBox4_Change()
    aantal(2) = Val(TextBox4.Text)
    TextBox4.Text = aantal(2)
End Sub

Private Sub TextBox5_Change()
    aantal(3) = Val(TextBox5.Text)
    TextBox5.Text = aantal(3)
End Sub

Private Sub TextBox6_Change()
    aantal(4) = Val(TextBox6.Text)
    TextBox6.Text = aantal(4)
End Sub

Private Sub TextBox7_Change()
    aantal(5) = Val(TextBox7.Text)
    TextBox7.Text = aantal(5)
End Sub

Private Sub TextBox8_Change()
    aantal(6) = Val(TextBox8.Text)
    TextBox8.Text = aantal(6)
End Sub

Private Sub UserForm_Initialize()

For i = 0 To 6
    aantal(i) = 0
Next i
dier(0) = "ko"
dier(1) = "ca"
dier(2) = "du"
dier(3) = "ho"
dier(4) = "kr"
dier(5) = "pa"
dier(6) = "wa"

End Sub

 

[danny147]

Beste wampier

Dit werkt naar behoren.

Kan je er ook nog een controle insteken.
Als men het liefhebbernr. intypt en deze bestaat al, dat hij dan bij het wegschrijven zegt "liefhebbernr bestaat reeds"
Ook als er geen liefhebbernr is ingevuld mag hij niets wegschrijven, maar ook een melding geven.

Groetjes Danny. :thumb:

 

[wampier]

Danny,

de code van commandbutton1_click als volgt vervangen:

Private Sub CommandButton1_Click()
    If (Val(TextBox1.Text)) = 0 Then
        MsgBox ("Graag een liefhebber opgeven")
        Exit Sub
    End If
    
    Dim zoeken As Range
    Set zoeken = [b:b].Find(what:=Val(TextBox1.Text), LookIn:=xlValues, lookat:=xlWhole)
    If Not zoeken Is Nothing Then
        MsgBox ("Graag een uniek liefhebber nr opgeven")
        Exit Sub
    End If

    Dim j As Integer
    Dim start As Range
    Set start = [b65000].End(xlUp).Offset(1, 0)
    For i = 0 To 6
        If (aantal(i)) Then
            For j = 1 To aantal(i)
                start = TextBox1.Text
                start.Offset(0, 1) = dier(i)
                Set start = start.Offset(1, 0)
            Next j
        End If
    Next i
    
End Sub

 

[danny147]

Beste wampier,

Bedankt voor de snelle reactie en de perfect werkende code.

Groetjes Danny. :thumb: