AW: Doppeleintrag für 2 Spalten verhindern
24.01.2005 10:36:22
Manni
Hallo Hübi,
danke für deine Formel. Sie funktioniert in der Adressenliste einwandfrei. Probleme bekomme ich allerdings wenn ich die Eingabe über eine bestehende Eingabe-Maske vornehme.
In diesem Falle blockt die Formel von dir nicht mehr ab. Das Makro der Eingabe-Maske sieht wie folgt aus:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Address = "$F$15" Then
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Sheets("Adressen").Range("lfdNr").Find(What:=Sheets("Maske").[F3], _
LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
MsgBox "Wert wurde nicht gefunden."
Else
Application.Goto rng, True
ActiveCell.EntireRow.Delete
Sheets("Maske").Select
Range("Formelkopie").Copy Range("F3")
Application.ScreenUpdating = True
Cancel = True
MsgBox "Kunde wurde gelöscht."
End If
End If
If ActiveCell.Address = "$E$15" Then
Application.ScreenUpdating = False
Dim rng1 As Range
Set rng1 = Sheets("Adressen").Range("lfdNr").Find(What:=Sheets("Maske").[F3], _
LookIn:=xlValues, LookAt:=xlWhole)
If rng1 Is Nothing Then
MsgBox "Wert wurde nicht gefunden."
Else
Application.Goto rng1, True
ActiveCell.Value = Sheets("Maske").Range("F3").Value
ActiveCell.Offset(0, 1).Value = Sheets("Maske").Range("F4").Value
ActiveCell.Offset(0, 2).Value = Sheets("Maske").Range("F5").Value
ActiveCell.Offset(0, 3).Value = Sheets("Maske").Range("F6").Value
ActiveCell.Offset(0, 4).Value = Sheets("Maske").Range("F7").Value
ActiveCell.Offset(0, 5).Value = Sheets("Maske").Range("F8").Value
ActiveCell.Offset(0, 6).Value = Sheets("Maske").Range("F9").Value
ActiveCell.Offset(0, 7).Value = Sheets("Maske").Range("F10").Value
ActiveCell.Offset(0, 8).Value = Sheets("Maske").Range("F11").Value
ActiveCell.Offset(0, 9).Value = Sheets("Maske").Range("F12").Value
ActiveCell.Offset(0, 10).Value = Sheets("Maske").Range("F13").Value
ActiveCell.Offset(0, 11).Value = Sheets("Maske").Range("F14").Value
Sheets("Maske").Select
Range("Formelkopie").Copy Range("F3")
Cancel = True
Application.ScreenUpdating = True
MsgBox "Kunde wurde geändert."
End If
End If
If ActiveCell.Address = "$C$15" Then
Dim LetzteZeile As Long
If Range("c3") = "" Then
MsgBox "Vorgang abgebrochen. Es muss mindestens ein Name eingegeben werden."
Exit Sub
End If
With Sheets("Adressen")
LetzteZeile = .Range("A65536").End(xlUp).Row + 1
.Cells(LetzteZeile, 1) = Range("c3")
.Cells(LetzteZeile, 2) = Range("c4")
.Cells(LetzteZeile, 3) = Range("c5")
.Cells(LetzteZeile, 4) = Range("c6")
.Cells(LetzteZeile, 5) = Range("c7")
.Cells(LetzteZeile, 6) = Range("c8")
.Cells(LetzteZeile, 7) = Range("c9")
.Cells(LetzteZeile, 8) = Range("c10")
.Cells(LetzteZeile, 9) = Range("c11")
.Cells(LetzteZeile, 10) = Range("c12")
.Cells(LetzteZeile, 11) = Range("c13")
.Cells(LetzteZeile, 12) = Range("c14")
End With
MsgBox "Werte hinzugefügt."
Application.ScreenUpdating = False
Range("c3:c14").ClearContents
Range("c3").FormulaR1C1 = "=MAX(lfdNr)+1"
Range("c3").Value = Range("c3").Value
Application.ScreenUpdating = True
Range("$C$3").Select
End If
End Sub
Kennst du dich auch mit VBA aus, dass du mir hierbei noch einmal helfen kannst?
Gruß
Manni