Gegevens in menu in vullen, dan in excel zetten

[MarnixE]

Hallo,

Ik heb een Statistieken bestand voor een voetbalclub, hierin houdt ik onder meer presentie, doelpunten, speelminuten bij (dit bestand is alleen te groot om up te loaden)..
Nou voer ik momenteel alles na de wedstrijd met hand in, best veel werk.. Nou heb ik bij iemand een bestand gezien waarin diegene nadat hij op open menu klikt veel dingen in kan vullen en deze in excel verschijnen. Zoiets zou ook perfect zijn voor mijn bestand. Nou heb ik een klein begin, zie de bijlage. Zodra er op de open menu knop gedrukt wordt en daarna op Speelminuten opent een venster zich met de spelers en daarachter een tekstvak waar de speelminuten ingevuld kunnen worden. Nou wil ik dat zodra ik achter iedere speler wat invul en daarna op invoegen klik, dat alle gegevens onder elkaar ergens verschijnen. Maar wat voor codes heb ik hiervoor nodig?


Bekijk bijlage Sjabloon beginverwerking.xls

 

[Warme bakkertje]

Die basiscode staat toch al in het Userform, je moet enkel de nodige aanpassingen doen betreffende werkbladnaam ??
En hoe is je werkblad met spelersnamen opgebouwd ?

 

[MarnixE]

Hallo Warm Bakkertje,


Mijn bladen, heb even speelminuten weer als voorbeeld genomen, zien er als volgt uit;
Dus op het moment dat ik het voor competitie invul moet hij iedere volgende wedstrijd een verder naar rechts ingevuld worden voor iedere speler.
En de formules voor het neerzetten in excel staan nog niet in de userform toch?

 

[Warme bakkertje]

Aan een jpg'tje hebben wij niks, het is zelfs niet duidelijk te lezen waar en wat.
Zoals ik al zei de BASIScode is al aanwezig.

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Uren")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.TextBox2.Value
ws.Cells(iRow, 3).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.TextBox7.Value
Unload Me
Worksheets("Uren").Select
End Sub

 

[MarnixE]

Excusus Warme Bakkertje

Bekijk bijlage speelminy.xlsx

 

[Warme bakkertje]

Ik heb alles volledig aangepast zoals het op het werkblad staat.

 

[MarnixE]

Super bedankt, Warme Bakkertje!
Hiermee gaat het zeker lukken, dank je!

 

[MarnixE]

Warme Bakkertje?
Zou u misschien nog één keer kunnen helpen?
Nadat ik het uiterlijk had aangepast en alle knoppen aan het juiste doel gekoppeld had, wou ik verder gaan met de code die u mij gegeven heeft.
Want zoals nu te zien valt Bekijk bijlage speelminy.xlsx is als je vanaf het menu naar invoer--> competitie gaat dat daar nu naast speelminuten, zeg maar alle in te voeren waarden staan.
Omdat ik uw code niet helemaal begrijp, vraag ik mij af hoe krijg ik nu bijvoorbeeld Assists (die nu ook in het bestand zit) op het moment dat ik ze invul en op INVOEGEN klik dat er het zelfde gebeurd als wat er nu al met de speelminuten gebeurd?
Zou u mij dit alstublieft voor kunnen doen?? Dan hoop ik het daarna met de andere waarden zelf te kunnen..
Alvast bedankt,

Marnix

 

[MarnixE]

Oh en trouwens Warme Bakkertje,

Eigenlijk alleen de Invoer--> Competitie knop werkt nu, deze heb ik uit het normale bestand gehaald want deze is 5 mb en de max hier is 100 kb. Daarom heb ik dus deze selectie er uit gehaald. Dus vandaar dat de codes er wel staan maar in dit bestand geen invloed hebben

 

[Warme bakkertje]

En waar is het Userform waarvoor die nieuwe code gemaakt moet worden ?

 

[MarnixE]

Sorry warme bakkertje, was ze vergeten er bij te doen. Heb het nu even op deze manier gedaan omdat met ook het speelminuten blad er bij dan was hij meer dan 100 kb...
Bekijk bijlage speelminy (1).xlsm Dus als je de userforms uit dit bestand in die andere wil zetten dan heb je al het benodigde materiaal volgens mij..

 

[Warme bakkertje]

Je zal toch eerst moeten zorgen dat al je Textboxen netjes gestructureerd op je invulformulier staan dwz kolom1 TB1 tem TB28, kolom2 TB29 tem TB56 enz...
Dan kan je met betrekkelijk eenvoudige loops alles in 1 keer wegschrijven naar de betreffende werkbladen, want zoals ze nu door elkaar staan gaat het zeker niet lukken.

 

[MarnixE]

Warme Bakkertje,

Ik zal morgen ochtend even alle textboxen goed nummeren... Heeft u een voorbeeld van zo'n loop dan bijvoorbeeld van 1t/m28 in ''Speelminuten'' en 29t/m57 op de zelfde plek en alles maar dan op het blad ''Assists overzicht'' dat ik dat dan zelf invul? Of moet ik hem morgen ochtend gewoon weer even hier op zetten dat u het doet?
Nog een ding, ik weet niet u of u het weet (gezien uw kennis, vast wel) bijvoorbeeld de InvulCompetitie userform is heel hoog en voor mn laptop beeldscherm is hij te groot, voor mn externe beeldscherm niet, maar weet u misschien of hier een scroll functie in te krijgen is, zodat hij gewoon normale afmetingen heeft en dat je dan naar beneden scrollt?
Alvast bedankt

Marnix

 

[Warme bakkertje]

Is het dan de bedoeling dat je dit nieuwe formulier in 1 keer volledig invult en dan wegschrijft, of dat je de ene keer de speelminuten invult en wegschrijft en op een later tijdstip een ander criteria?

 

[MarnixE]

Alles in 1 x invullen en wegschrijven!

 

[Warme bakkertje]

Dan heb je in mijn eerdere bestand toch al een voorbeeld van een loop staan?
Je moet dan enkel de bladnaam aanpassen en eventueel het bereik waarheen geschreven moet worden.
De enige aanpassing die eventueel nog gemaakt kan worden is dat wanneer geen waarde ingevuld wordt er toch een 0 weggeschreven wordt, dit om fouten te vermijden.

 

[MarnixE]

Klopt het voorbeeld is er, zou je dan alleen nog even kort de loop toe kunnen lichten, zodat ik precies weet waar alles in te vullen. Die 0 invullen hoe doe ik die aanpassing in de loop? En dan nog even wat ik eerder schreef: "Nog een ding, ik weet niet u of u het weet (gezien uw kennis, vast wel) bijvoorbeeld de InvulCompetitie userform is heel hoog en voor mn laptop beeldscherm is hij te groot, voor mn externe beeldscherm niet, maar weet u misschien of hier een scroll functie in te krijgen is, zodat hij gewoon normale afmetingen heeft en dat je dan naar beneden scrollt?"

 

[Warme bakkertje]

Voeg een standaardmodule in en ga dan als volgt tewerk

Sub Speelminuten()
Dim iCol As Long, data(28)
With Worksheets("Speelminuten")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(6, 50).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Assists()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Maak nu voor elk werkblad een nieuwe sub aan.
De Macro's in je formulier Invulcompetitie gaan er dan zo uitzien

Private Sub CommandButton1_Click()
    Speelminuten
    Assists
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
    Menu.Show
End Sub

Private Sub CommandButton3_Click()
    Speelminuten
    Assists
    Unload Me
    UserForm1.Show
End Sub

 

[MarnixE]

Warme Bakkertje,

Ik heb nu alles ingevoerd in een module: Sub Speelminuten()

Dim iCol As Long, data(28)
With Worksheets("Speelminuten")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(6, 50).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Presentie()
Dim iCol As Long, data(28)
With Worksheets("Presentielijst Wedstrijden")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Geel()
Dim iCol As Long, data(28)
With Worksheets("Gele Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Rood()
Dim iCol As Long, data(28)
With Worksheets("Rode Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Kaarten()
Dim iCol As Long, data(28)
With Worksheets("Kaarten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Assists()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Doelpunten()
Dim iCol As Long, data(28)
With Worksheets("Doelpunten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

en dan in het UserForm:

Private Sub CommandButton1_Click()
    Speelminuten
    Presentie
    Geel
    Rood
    Kaarten
    Assists
    Doelpunten
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
    Menu.Show
End Sub

Private Sub CommandButton3_Click()
    Speelminuten
    Presentie
    Geel
    Rood
    Kaarten
    Assists
    Doelpunten
    Unload Me
    InvulCompetitie.Show
End Sub

Maar als ik nu wat invoer zegt hij:

Compileerfout:

Ongeldig gebruik van het sleutelwoord Me

Wat is er fout? Waar ligt het aan? kan er zelf weinig verkeerds in vinden...

 

[Warme bakkertje]

Vervang in al de macro's het woord Me door InvulCompetitie