Moderator: Moderatoren
Leider funktioniert dein Lösungsweg bei mir nicht. Verhindert dieser denn komplett die Doppeleintragung, inklusive Fehlermeldung, oder werden hier lediglich alle Duplikate rot markiert?miesepeter hat geschrieben:Hallo und ja ich möchte -
du könntest es mit einer bedingten Formatierung realisieren. Die bedingte Formatierung wird in Zelle B1 eingegeben und dann mit dem Formatübertragungspinsel auf alle anderen Zellen der Spalte B übertragen. (Mischung absolute und relative Adressierung - siehe Screenshot.)
Ciao
Hallo,Sandy86 hat geschrieben:verhindert dieser denn komplett die Doppeleintragung, inklusive Fehlermeldung, oder werden hier lediglich alle Duplikate rot markiert?
Evtl. steht die eine Bedingung den anderen zweien (welche rein dem Zweck der Formatierung des Zellhintergrunds dienen - Screenshot) widersprüchlich gegenüber?
Code: Alles auswählen
Function pruefen(CellValue As String, CellAddress As String) As Boolean
oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )
oXCellRange = thiscomponent.Sheets(0).getCellRangeByName("$B$1:$B$2500")
oXCell = thiscomponent.Sheets(0).getCellRangeByName("B1").Value
Dim args(1) As Variant
args(0) = oXCellRange
args(1) = oXCell
result = oFunctionAccess.callFunction("COUNTIF",args())
If result >= 1 AND VAL(CellValue) = oXCell Then
Msgbox "schon vorhanden"
pruefen = False
Else
pruefen = True
End If
End Function
ja, werden sie. Bei der gegeben Reihenfolge wird dadurch ein roter Hintergrund u.U. überschrieben. Also erste Bedingung an letzte Stelle und es sollte gehenOb die Bedingungen von oben nach unten abgearbeitet werden
In der Tat. Danke für Deine Aufmerksamkeit und den Hinweis.Da muss ich dir nach einem Test widersprechen! Ist die erste Bedingung erfüllt, bleiben die weiteren Bedingzngen unbebachtet.
Das heißt, wenn die Bedingung für "Rot" eintritt, wir die Zelle rot gefärbt, egal was danach noch für Bedingungen kommen.
Ja, ich habe das Layout, um Verwirrungen bezüglich des obigen "Zellhintergrundfarbenproblems" auszumerzen, etwas verändert. Wundert Euch also bitte nicht.paljass als Gast hat geschrieben:Eventuell waäre eine Beispieldatei zum Nachgucken gut.
Code: Alles auswählen
Function pruefen(CellValue As String, CellAddress As String) As Boolean
oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )
oXCellRange = thiscomponent.Sheets.getbyname("Alle Teile_2").getCellRangeByName("$B$1:$B$10000")
oXCell = thiscomponent.Sheets.getbyname("Alle Teile_2").getCellRangeByName(CellAddress)
oXCell.formula = CellValue
Dim args(1) As Variant
args(0) = oXCellRange
args(1) = oXCell.formula
result = oFunctionAccess.callFunction("COUNTIF",args())
If result >= 1 Then
msgbox ("Die Seriennummer ist bereits vorhanden!",16,"Doppelter Eintrag")
pruefen = False
Else
pruefen = True
End If
End FunctionCode: Alles auswählen
If result > 1 ThenCode: Alles auswählen
If result >= 1 ThenCode: Alles auswählen
Function pruefen(CellValue As String, CellAddress As String) As Boolean
oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )
oXCellRange = thiscomponent.Sheets.getbyname("Alle Teile_2").getCellRangeByName("$B$1:$B$10000")
oXCell = thiscomponent.Sheets.getbyname("Alle Teile_2").getCellRangeByName(CellAddress)
oXCell.formula = CellValue
Dim args(1) As Variant
args(0) = oXCellRange
args(1) = oXCell.formula
result = oFunctionAccess.callFunction("COUNTIF",args())
If result > 1 Then
if msgbox ("Die Seriennummer ist bereits vorhanden!"&chr(13)&"Soll die Neueingabe gelöscht werden?",20,"Doppelter Eintrag") = 6 then
oXCell.formula = ""
endif
pruefen = False
Else
pruefen = True
End If
End Function