Applicatie gaat niet verder dan rij 256

Status
Niet open voor verdere reacties.

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.
 

Bijlagen

  • pkb12 gegevens.JPG
    pkb12 gegevens.JPG
    67,1 KB · Weergaven: 51
Laatst bewerkt:
Zorg ervoor dat de rijen vanaf 256 zichtbaar zijn.

Voer de controles op de invoer door de gebruiker uit voordat op de vervolgknop gecrukt kan worden:

Code:
Knop_vervolg.visible= txtorder.text <>"" and & txtdate.text <> "" & order=true

En deze code is ook interessant:
Code:
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
3 verschillende voorwaarden die tot hetzelfde resultaat leiden.
 
Zorg ervoor dat de rijen vanaf 256 zichtbaar zijn.

Voer de controles op de invoer door de gebruiker uit voordat op de vervolgknop gecrukt kan worden:

Code:
Knop_vervolg.visible= txtorder.text <>"" and & txtdate.text <> "" & order=true

En deze code is ook interessant:
Code:
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
3 verschillende voorwaarden die tot hetzelfde resultaat leiden.

Waar moet ik de regel Knop_vervolg.visible= txtorder.text <>"" and & txtdate.text <> "" & order=true toevoegen in de code?
 
maak er een aparte macro van:

Code:
Sub kontrole()
  Knop_vervolg.visible= txtorder.text <>"" and & txtdate.text <> "" & order=true
End sub

en start die macro in de onderdelen waar het om gaat:
Code:
Private Sub txt.order_change()
  kontrole
End sub

Code:
Private Sub txt.date_change()
  kontrole
End sub
Code:
Private Sub order_change()
  kontrole
End sub
 
Het probleem lag bij de formule:

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

Het limiet van het aantal kolommen ligt op 256
Columns veranderen in Rows dan heb je een limiet van 65536
En het probleem is opgelost.
:D
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan