Umwandlung einer siebenstelligen Zahl (Prüfziffer)
17.07.2007 11:14:00
Josef
Mit dem ersten Makro werden bei der Eingabe einer siebenstelligen Zahl in der nächsten freien Zelle der Spalte 10 in der Tabelle1 die ersten 6 Zahlen sowie die Prüfziffer /7 als siebenstellige Zahl in der nächsten freien Zelle der spalte C eingetragen.
Mit dem zweiten Makro wird bei der Eingabe einer siebenstelligen Zahl in der nächsten freien Zelle der Spalte 10 in der Tabelle1 diese Zahl 1 zu 1 in der nächsten freien Zelle in der Spalte 3 in der Tabelle 1 eingetragen und die ersten 6 Stellen dieser Zahl in der sPalte AD,AE,AF aufgeteilt in jeweils 2 Stellen eingetragen.
Wie und wo müßte ich den Code im zweiten Makro verändern, damit die Zahl in der "Tabelle1" in der nächsten freien Zelle ebenfalls mit der Prüfziffer /7 eingetragen (so wie im Makro 1) wird und danach die Splittung der Nummer erfolgt.?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim efz As Long, c As Range, strS As String
On Error GoTo Weiter
If Target.Column = 10 And Target.Row > 1 Then
strS = Left(Target, 6) & (CLng(Left(Target, 6)) Mod 7)
With Worksheets("Tabelle1")
Set c = .Columns(3).Find(strS, LookAt:=xlWhole)
If c Is Nothing Then
efz = .Cells(Rows.Count, 3).End(xlUp).Row + 1
Else
efz = c.Row
MsgBox strS & " ist schon vorhanden."
Target.ClearContents
Target.Activate
End If
.Cells(efz, 3).Value = strS
End With
End If
End Sub
'*********************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LoLetzte As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 10 Then
Application.EnableEvents = False
With Worksheets("Tabelle1")
'''''' letzte belegte Zeile unabhängig von Excelversion für Spalte C (3)
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp) _
_
.Row, .Rows.Count) + 1
.Cells(LoLetzte, 3) = Target
If Len(Target) >= 6 Then
LoLetzte = IIf(IsEmpty(Worksheets("Tabelle1").Cells(Rows.Count, 30)), _
Worksheets("Tabelle1").Cells(.Rows.Count, 30).End( _
xlUp).Row, Rows.Count) + 1
.Range("Ad" & LoLetzte) = Left(Target, 2)
LoLetzte = IIf(IsEmpty(Worksheets("Tabelle1").Cells(Rows.Count, 31)), _
Worksheets("Tabelle1").Cells(.Rows.Count, 31).End( _
xlUp).Row, Rows.Count) + 1
.Range("AE" & LoLetzte) = Mid(Target, 3, 2)
.Range("AF" & LoLetzte) = Mid(Target, 5, 2)
LoLetzte = IIf(IsEmpty(Worksheets("Tabelle1").Cells(Rows.Count, 32)), _
Worksheets("Tabelle1").Cells(.Rows.Count, 32).End( _
xlUp).Row, Rows.Count) + 1
End If
End With
Application.EnableEvents = True
End If
End Sub
Danke
Josef