Makro Mehrfachnennung; Makro Datensatzschutz

01/09/2008 - 10:35 von Wilfried | Report spam
Kann mir jemand helfen ? Ich benötige 2 Makros mit folgenden Funktionen:

1. Prüfung ob die Spaltenkombination eines Datensatzes einer Tabelle
mehrfach vorkommt
Die Spalten 2, 4, 6, 8 eines Tabellenblattes sollen in dieser Kombination
nur in einem Datensatz vorkommen dürfen. Falls sie öfters als 1 x in der
gesamten Tabelle auftauchen, sollen die doppelt genannten Zellen
a) im Format rot und fett gekennzeichnet werden.
b) soll in Spalte 2 ein Fenster mit (rot, fett) "Mehrfachnennung" aufklappen.

Leerzeichen sollen nicht berücksichtigt werden (z.B. AB 123 = AB123).
Beispiel () gibt Spaltenzahl an
(1) 001 (2) leer (3)AB 123 – (5)DE – (7)0888
– (9)one
(1) 001 (2) Mehrfachnennung (3)AB 123 – (5)DE – (7)0888 – (9)one
[bis hier rot, fett]


2. Tabellenbereiche sollen nach Schließen und neuem Öffnen der Datei nicht
mehr verànderbar sein.
Hier sollen Ordnungsnummer eindeutig einem Datensatz zugeordnet und nicht
mehr verànderbar sein. Nach 1.Speichern, 2.Schließen und 3.erneutem Öffnen
gilt:
a) nicht erlaubt: Inhaltliche Änderung Spalten (1) (3) (5) (7) (9)
b) nicht erlaubt: Löschen von Zeilen
c) nicht erlaubt: Löschen von Spalten
d) erlaubt: Änderung von Format und aller Zeilen und Spalten
e) erlaubt: Kopieren aller Zeilen ohne Spalte (1)
f) erlaubt: Speichern unter neuem Dateinamen

Vielen Dank schon im Voraus
 

Lesen sie die antworten

#1 Andreas Killer
02/09/2008 - 10:38 | Warnen spam
Wilfried schrieb:

Kann mir jemand helfen ? Ich benötige 2 Makros mit folgenden Funktionen:
1. Prüfung ob die Spaltenkombination eines Datensatzes einer Tabelle
mehrfach vorkommt


Der Rest Deiner Beschreibung klingt ein bißchen wirr, mit
"Fensteraufklappen" meinst Du bestimmt was anderes als ich denke, aber
so ungefàhr, denke ich, könnte das hier in Deinem Sinne gehen. Der
Einfachheit halber habe ich einfach mal alle doppleten Zeilen komplett
rot/fett markiert, nicht nur die verglichenen Zellen.

Sub SucheDoppelt()
Dim Y As Long, J As Long, Ymax As Long
Dim I As Integer
Dim Spalten As Variant
Dim Data1 As String, Data2 As String
Dim Temp1 As String, Temp2 As String
Dim Found As Boolean

'Zu vergleichende Spalten A=1, B=2, usw., kannst Du beliebig anpassen
Spalten = Array(1, 3, 5, 7, 9)

'Starte bei Zeile 2, Zeile 1 enthàlt die Überschriften?!
Y = 2
'Zeile des letzten Datensatzes
Ymax = Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Alle Doppeltmarkierungen entfernen
With Rows(Y & ":" & Ymax).Font
.ColorIndex = xlAutomatic
.Bold = False
End With
'Und los geht's
Do While Y < Ymax
'Index der ersten Spalte
I = LBound(Spalten)
'Ist dieser Datensatz schon als doppelt markiert?
With Cells(Y, Spalten(I)).Font
If .ColorIndex = 3 And .Bold Then GoTo Next1
End With
'Daten ohne Leerzeichen holen
Data1 = Replace(Cells(Y, Spalten(I)), " ", "")
'Starte die Suche ab der nàchsten Zeile
J = Y + 1
Do While J <= Ymax
'Index der ersten Spalte
I = LBound(Spalten)
'Ist dieser Datensatz schon als doppelt markiert?
With Cells(J, Spalten(I)).Font
If .ColorIndex = 3 And .Bold Then GoTo Next2
End With
'Daten ohne Leerzeichen holen
Data2 = Replace(Cells(J, Spalten(I)), " ", "")
'Gleiche Daten gefunden?
If StrComp(Data1, Data2, vbTextCompare) = 0 Then
Found = True
'Rest der Daten vergleichen
For I = LBound(Spalten) + 1 To UBound(Spalten)
Temp1 = Replace(Cells(Y, Spalten(I)), " ", "")
Temp2 = Replace(Cells(J, Spalten(I)), " ", "")
If Not StrComp(Temp1, Temp2, vbTextCompare) = 0 Then
Found = False
Exit For
End If
Next
'Gleicher Datensatz gefunden?
If Found Then
'Datensàtze markieren
'Diesen Kommentar ggf. auskommentieren:
' Cells(Y, 2) = "Mehrfachnennung"
' Cells(J, 2) = "Mehrfachnennung"
With Rows(Y).Font
.ColorIndex = 3
.Bold = True
End With
With Rows(J).Font
.ColorIndex = 3
.Bold = True
End With
End If
End If
Next2:
'Weitersuchen
J = J + 1
Loop
Next1:
Y = Y + 1
Loop
End Sub


2. Tabellenbereiche sollen nach Schließen und neuem Öffnen der Datei nicht
mehr verànderbar sein.


Vergiss es, ist ein Riesenaufriss, frißt jede Menge Ressouren und bleibt
so oder so fehleranfàllig.

Mfg, Andreas.

Ähnliche fragen