Automatischer sheet Eintrag

Forumthread: Automatischer sheet Eintrag

Cris

Hallo Ihr da draußen,
sitze schon den ganzen Nachmittag über einem Problem, von dem ich denke, dass es eine ganz schöne Nuss ist.

Die Datei https://www.herber.de/bbs/user/4865.xls wurde aus Datenschutzgründen gelöscht

Ich habe eine Excel Tabelle mit z.B. 5 sheets. In jedem der 4 sheet werden Namen von verschiedenen Teilnehmern eingetragen und im fünften sheet sollen alle Teilnehmer aus allen 4 sheets automatisch erscheinen. Allerdings kann es passieren, dass in 2 der 4 sheets ein Teilnehmer doppelt erscheint. Dies soll in dem fünften sheet durch eine Info (z.B. rot markiert) deutlich werden, so, dass die Person aus einem sheet entfernt werden kann (bei bedarf).
Zusätzlich muß natürlich die Info im fünften sheet da sein, woher die jeweiligen Personen kommen.
Hoffentlich könnt Ihr mir helfen diese Nuss zu knacken.
Vielen Dank im voraus.
Cris

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Automatischer sheet Eintrag

01.04.2004 19:33:01

Christoph

Hi Cris,
mit "Vergleich" als MatrixFormel lässt sich das lösen:
Gebe in Zelle C2 ein:
{=VERGLEICH($A2&$B2;'1'!$A$2:$A$3&'1'!$B$2:$B$3;0)}
oder wenn du noch 'ne Fehlerabfangung einbauen willst, dann:
{=WENN(ISTFEHLER(VERGLEICH($A2&$B2;'1'!$A$2:$A$3&'1'!$B$2:$B$3;0));"";VERGLEICH($A2&$B2;'1'!$A$2:$A$3&'1'!$B$2:$B$3;0))}
die Formel kannst du jeweils nach unten ausfüllen.
für die weiteren Spalten musst du den Tabellennamen korigieren
geschweifte Klammern nicht eingeben, sondern die Formel über "Strg-Shift-Enter" abschließen
Gruß
Christoph
('ne Rückmeldung wäre nett)

AW: Automatischer sheet Eintrag

ChrisL

Hi Cris
Und hier etwas mit VBA...
Option Explicit


Sub Machmal()
Dim iBlatt As Byte
Dim iZeile As Long, iiZeile As Long
Dim Zusammen As Worksheet, WS As Worksheet
Dim Vorhanden As Boolean
Set Zusammen = Worksheets("Zusammenfassung")
Zusammen.Range("A2:F65536").Delete
For iBlatt = 2 To 5
Set WS = Worksheets(iBlatt)
For iZeile = 2 To WS.Range("A65536").End(xlUp).Row
Vorhanden = False
For iiZeile = 2 To Zusammen.Range("A65536").End(xlUp).Row
If Zusammen.Cells(iiZeile, 1) = WS.Cells(iZeile, 1) And _
Zusammen.Cells(iiZeile, 2) = WS.Cells(iZeile, 2) Then
Vorhanden = True
Exit For
End If
Next iiZeile
If Vorhanden = True Then
Zusammen.Cells(iiZeile, iBlatt + 1) = "x"
Else
Zusammen.Cells(iiZeile, 1) = WS.Cells(iZeile, 1)
Zusammen.Cells(iiZeile, 2) = WS.Cells(iZeile, 2)
Zusammen.Cells(iiZeile, iBlatt + 1) = "x"
End If
Next iZeile
Next iBlatt
With Zusammen.Range("A2:F" & iiZeile)
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=WENN(ZÄHLENWENN($A2:$F2;""x"")>1;WAHR;)"
.FormatConditions(1).Font.ColorIndex = 3
End With
End Sub

Gruss
Chris

AW: Automatischer sheet Eintrag

Bert

Gut gemacht, aber stimmt die bedingte Formatierung so?
Bert

AW: Automatischer sheet Eintrag

ChrisL

Hi Bert
Sagen wir's so... im Test hats funktioniert, aber die Suchfunktion von Beni scheint mir sowieso geeigneter darum würde ich seinen Code verwenden.
Gruss
Chris

Vorsicht

Christoph

Hi Chris,
die Suchfunktion von Beni scheint mir generell geeignet, aber Vorsicht.
Der Code von Beni steigt bei doppelten Vornamen aus!
Gruß
Chritoph

Korrektur

ChrisL

Hi
Bert hatte recht, die Bedingte Formatierung funktioniert nicht richtig. Betr. der Suchfunktion habe ich noch eine CountIf-Funktion eingebaut, das müsste den Ablauf etwas verbesseren.
Gruss
Chris

AW: Automatischer sheet Eintrag

01.04.2004 20:12:35

Beni

Hallo Cris,
Gruss Beni
https://www.herber.de/bbs/user/4870.xls


Sub Cris()
Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 6)).Font.ColorIndex = 0
Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 6)).ClearContents
For w = 2 To 5
With Sheets(w)
For z = 2 To .Cells(65536, 1).End(xlUp).Row
r = Cells(65536, 1).End(xlUp).Row + 1
sFind2 = .Cells(z, 2)
Set C = Sheets(1).Columns(2).Find(sFind2, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then x = 1
sFind1 = .Cells(z, 1)
Set C = Sheets(1).Columns(1).Find(sFind1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then x = x + 1
If x = 2 Then
Range(C(1, 1), C(1, 6)).Font.ColorIndex = 3
C(1, w + 1) = "x"
x = ""
Else
Cells(r, 1) = .Cells(z, 1)
Cells(r, 2) = .Cells(z, 2)
Cells(r, w + 1) = "x"
End If
Next z
End With
Next w
End Sub

AW: Automatischer sheet Eintrag

Nepumuk

Hallo Cris,
oder so: https://www.herber.de/bbs/user/4871.xls
Gruß
Nepumuk

@Nepumuk

Christoph

Hi Nepumuk,
auch nicht schlecht, aber...
wenn ich den selben Eintrag in einem Tabellenblatt in die selbe Zeile nochmal eintrage, dann...du weißt schon.
Gruß
Christoph

Beliebteste Forumthreads (12 Monate)

Forumthread: Automatischer sheet Eintrag

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread