Office: Code für Zeilensprung auf 125 Ändern

Hallo,

Ich habe mein Excel Datei auf 125 Prüflinge erhöht (vorher war es nur bis 75)
Code habe ich auch angepasst damit es automatisch weiter springt beim messen.
nur es funktioniert nicht mehr der Zeilensprung.

Kann jemand bitte den Code anpassen damit es wieder funktioniert.

Grüße Andre

 

Hallo,

hier haben wir (wieder einmal) ein hausgemachtes Problem. Warum wird eine Datei zur Datenerfassung aufgebaut wie ein Papierformular? So arbeitet man einfach nicht.

 

Hallo,

so arbeiten wir bei unserer Firma

 

Hallo,

jau, zu solchen Einstellungen passt auch der Quelltext, wer hat den denn geklöppelt?

Nachtrag: es gab da mal einen Holzfäller, der schaffte sein Tagespensum nicht, weil er keine Zeit hatte, seine Säge zu schärfen.

 

Hallo,

in der beiliegenden Datei habe ich ein zweites Arbeitsblatt "Tabelle2" eingefügt. Das dazugehörige Codemodul habe ich total umgekrempelt und simplifiziert. Ich hoffe, es erfüllt trotzdem seinen Zweck:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

   If Not Intersect(Range("D11"), Target) Is Nothing Then Range("I13").Select
   If Not Intersect(Range("I13"), Target) Is Nothing Then Range("B17").Select
   If Not Intersect(Range("B17"), Target) Is Nothing Then Range("G17").Select
   If Not Intersect(Range("G17"), Target) Is Nothing Then Range("L17").Select
   If Not Intersect(Range("L17"), Target) Is Nothing Then Range("C32").Select
  
   If Target.Row > 25 Then Call NächsterMesswert(Target)

End Sub

Sub NächsterMesswert(ByVal Target As Range)
   Dim PrüfMenge As Integer
   Dim PrüfNr As Variant
   Dim AktZelle As Range
  
   PrüfMenge = Me.Range("D13").Value
   Set AktZelle = Target
    
   PrüfNr = Me.Cells(AktZelle.Row, "A")  'aus Spalte A
   If IsNumeric(PrüfNr) Then
     If PrüfNr < PrüfMenge Then
        'selbe Messwertspalte - nächeste Zeile
NxtMesswZeile:
        Do
           Set AktZelle = AktZelle.Offset(1)
           PrüfNr = Me.Cells(AktZelle.Row, "A")
           If IsNumeric(PrüfNr) Then If PrüfNr Then Exit Do
        Loop
     Else
        'nächste Messwertspalte - Anfang
        Set AktZelle = Me.Cells(32, AktZelle.Offset(0, 2).Column)
        If AktZelle.Offset(-1, 0).Value Like "Nr." Then
           Set AktZelle = AktZelle.Offset(0, 1)
        End If
     End If
   Else
     'Keine Messwertzeile - suche nächste
     GoTo NxtMesswZeile
   End If
   AktZelle.Select
End Sub

 

Vielen Dank.
das funktioniert sogar besser als ich wollte.
Mit freundlichen Grüßen
Andre