Hoefplan26
Gebruiker
- Lid geworden
- 5 aug 2009
- Berichten
- 38
Hallo,
Ik gebruik deze formule voor mijn werk.
Hij werkt prima totdat hij rij 256 bereikt, dan blijft hij daar en gaat niet verder door.
Misschien heeft iemand een suggestie dat de applicatie doorgaat?
Alvast bedankt voor de reactie.
Private Sub toevoegen_Click()
'beveiliging opheffen
ActiveSheet.Unprotect Password:=""
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Nacontrole")
'find first empty row in database
If order Then
iRow = ws.Cells(Columns.Count, 3) _
.End(xlUp).Offset(3, 0).Row
Else
iRow = ws.Cells(Columns.Count, 3) _
.End(xlUp).Offset(1, 0).Row
End If
'check for a ordernummer
If order And (Me.txtorder.Value) = "" Then
Me.txtorder.SetFocus
MsgBox "U heeft geen ordernummer ingevuld ingevuld of u moet het selectievak Nieuw order uitvinken."
Exit Sub
End If
'check for neworder
If Not (Me.txtorder.Value) = "" And Not order Then
MsgBox (" U moet het selectievak Nieuwe order aanvinken")
Exit Sub
End If
'check for a datum
If order And (Me.txtdate.Value) = "" Then
Me.txtdate.SetFocus
MsgBox "U heeft geen datum ingevuld ingevuld"
Exit Sub
End If
'Check of pakketten goed of fout zijn gestapeld
If Me.goed = False And Me.fout = False Then
MsgBox ("Vink aan of de pakketten goed of fout zijn gestapeld.")
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtorder.Value
ws.Cells(iRow, 2).Value = Me.txtpakketnr.Value
ws.Cells(iRow, 3).Value = Me.txtafwli.Value
ws.Cells(iRow, 4).Value = Me.txtafwrechts.Value
ws.Cells(iRow, 5).Value = WorksheetFunction.Average(Me.txtafwli.Value, Me.txtafwrechts.Value)
ws.Cells(iRow, 6).Value = Me.txthaaksboven.Value
ws.Cells(iRow, 7).Value = Me.txthaaksonder.Value
If ws.Cells(iRow, 6).Value > 0 Then
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
ElseIf ws.Cells(iRow, 6).Value < 0 And ws.Cells(iRow, 7).Value > 0 Then
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
Else
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
End If
ws.Cells(iRow, 9).Value = Me.txtdate.Value
If Me.goed = True Then
ws.Cells(iRow, 10).Value = "Goed"
ElseIf Me.fout = True Then
ws.Cells(iRow, 10).Value = "Fout"
End If
ws.Cells(iRow, 11).Value = Me.txtopmerking.Value
'Zoek laatst lege cel en zet de gemiddelde formule er in.'
With Sheets("Nacontrole").Columns(5).SpecialCells(xlCellTypeConstants)
Sheets("Nacontrole").Cells(Rows.Count, 5).End(xlUp).Offset(1) = WorksheetFunction.Average(.Areas(.Areas.Count))
End With
With Sheets("Nacontrole").Columns(8).SpecialCells(xlCellTypeConstants)
Sheets("Nacontrole").Cells(Rows.Count, 8).End(xlUp).Offset(1) = WorksheetFunction.Average(.Areas(.Areas.Count))
End With
'clear the data
Me.order = False
Me.txtorder = ""
Me.txtpakketnr.Value = ""
Me.txtafwli.Value = ""
Me.txtafwrechts.Value = ""
Me.txthaaksboven.Value = ""
Me.txthaaksonder.Value = ""
Me.txtdate.Value = ""
Me.txtopmerking.Value = ""
Me.goed = False
Me.fout = False
Me.txtorder.SetFocus
ActiveSheet.Protect Password:=""
End Sub
Helaas het bestand is 178 kb en ik mag maximaal 100 kb uploaden.
Maar het gaat er om dat hij de laatst lege cel vindt in kolom 5 hierna gaat hij terug in de kolom naar de vorige lege cel. Tussen de lege cellen staan waardes waarbij hij dan in de laatst lege cel het gemiddelde berekend stuur een printscreen van de laatste rij.
Ik gebruik deze formule voor mijn werk.
Hij werkt prima totdat hij rij 256 bereikt, dan blijft hij daar en gaat niet verder door.
Misschien heeft iemand een suggestie dat de applicatie doorgaat?
Alvast bedankt voor de reactie.
Private Sub toevoegen_Click()
'beveiliging opheffen
ActiveSheet.Unprotect Password:=""
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Nacontrole")
'find first empty row in database
If order Then
iRow = ws.Cells(Columns.Count, 3) _
.End(xlUp).Offset(3, 0).Row
Else
iRow = ws.Cells(Columns.Count, 3) _
.End(xlUp).Offset(1, 0).Row
End If
'check for a ordernummer
If order And (Me.txtorder.Value) = "" Then
Me.txtorder.SetFocus
MsgBox "U heeft geen ordernummer ingevuld ingevuld of u moet het selectievak Nieuw order uitvinken."
Exit Sub
End If
'check for neworder
If Not (Me.txtorder.Value) = "" And Not order Then
MsgBox (" U moet het selectievak Nieuwe order aanvinken")
Exit Sub
End If
'check for a datum
If order And (Me.txtdate.Value) = "" Then
Me.txtdate.SetFocus
MsgBox "U heeft geen datum ingevuld ingevuld"
Exit Sub
End If
'Check of pakketten goed of fout zijn gestapeld
If Me.goed = False And Me.fout = False Then
MsgBox ("Vink aan of de pakketten goed of fout zijn gestapeld.")
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.txtorder.Value
ws.Cells(iRow, 2).Value = Me.txtpakketnr.Value
ws.Cells(iRow, 3).Value = Me.txtafwli.Value
ws.Cells(iRow, 4).Value = Me.txtafwrechts.Value
ws.Cells(iRow, 5).Value = WorksheetFunction.Average(Me.txtafwli.Value, Me.txtafwrechts.Value)
ws.Cells(iRow, 6).Value = Me.txthaaksboven.Value
ws.Cells(iRow, 7).Value = Me.txthaaksonder.Value
If ws.Cells(iRow, 6).Value > 0 Then
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
ElseIf ws.Cells(iRow, 6).Value < 0 And ws.Cells(iRow, 7).Value > 0 Then
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
Else
ws.Cells(iRow, 8).Value = WorksheetFunction.Sum(ws.Cells(iRow, 6).Value) - (ws.Cells(iRow, 7).Value)
End If
ws.Cells(iRow, 9).Value = Me.txtdate.Value
If Me.goed = True Then
ws.Cells(iRow, 10).Value = "Goed"
ElseIf Me.fout = True Then
ws.Cells(iRow, 10).Value = "Fout"
End If
ws.Cells(iRow, 11).Value = Me.txtopmerking.Value
'Zoek laatst lege cel en zet de gemiddelde formule er in.'
With Sheets("Nacontrole").Columns(5).SpecialCells(xlCellTypeConstants)
Sheets("Nacontrole").Cells(Rows.Count, 5).End(xlUp).Offset(1) = WorksheetFunction.Average(.Areas(.Areas.Count))
End With
With Sheets("Nacontrole").Columns(8).SpecialCells(xlCellTypeConstants)
Sheets("Nacontrole").Cells(Rows.Count, 8).End(xlUp).Offset(1) = WorksheetFunction.Average(.Areas(.Areas.Count))
End With
'clear the data
Me.order = False
Me.txtorder = ""
Me.txtpakketnr.Value = ""
Me.txtafwli.Value = ""
Me.txtafwrechts.Value = ""
Me.txthaaksboven.Value = ""
Me.txthaaksonder.Value = ""
Me.txtdate.Value = ""
Me.txtopmerking.Value = ""
Me.goed = False
Me.fout = False
Me.txtorder.SetFocus
ActiveSheet.Protect Password:=""
End Sub
Helaas het bestand is 178 kb en ik mag maximaal 100 kb uploaden.
Maar het gaat er om dat hij de laatst lege cel vindt in kolom 5 hierna gaat hij terug in de kolom naar de vorige lege cel. Tussen de lege cellen staan waardes waarbij hij dan in de laatst lege cel het gemiddelde berekend stuur een printscreen van de laatste rij.
Bijlagen
Laatst bewerkt: