PDA

Vollständige Version anzeigen : Zelle per Doppelklick aktivieren dann in andere Tabellen suchen und Meldung ausgeben


Gerd1
30.08.2010, 20:21
Hallo zusammen,
ich hab mal wieder ein Problem und keine Idee wie ich das lösen kann.
Ich habe in meiner Arbeitsmappe mehrere Tabellen, eine mit dem Namen Prüfung und die andere heißt Schichteinteilung, die anderen Tabellen sind gleich aufgebaut aber enthalten andere Namen.
Beide Tabellen sind ähnlich aufgebaut, in A2 bis A53 steht die Kalenderwoche und in A1 bis A xy- stehen Namen.
In der Tabelle Schichteinteilung stehen die Schichtwochen mit F für Frühschicht und S für Spätschicht. Wenn ein Mitarbeiter Urlaub hat steht hier ein U und wenn er keine ganze Woche Urlaub hat steht hier in der Frühschichtwoche ein FU.
In der Tabelle Prüfung sind Kleinbuchstaben "Inaktiv" und Großbuchstaben "Aktiv".
Wenn ich nun z.B. bei Name1 in KW 1 den Eintrag aktiviere soll geprüft werden ob der Name in Schichteinteilung ein U oder FU hat, wenn ja soll eine MSGBOX aufgehen mit einer entspechenden Meldung als Hinweis.
Mein Problem ist nun den Namen und die Kalenderwoche in der Tabelle Schichteinteilung zu finden, denn der Name in Tabelle Schichteinteilung kann immer an einer anderen Stelle stehen.
Ich hänge ein Beispieldatei an und wäre sehr froh wenn jemand von euch eine lösung für mich hätte

hary
31.08.2010, 08:14
Hallo Gerd
Eine Moeglichkeit. Teste mal im Anhang.
gruss hary
fuer Mitleser:
edit: evtl MsgBox Zeile aendern in:
MsgBox "Mitarbeiter: " & finde & Chr(10) & " hat " & .Cells(Target.Row, c.Column).Value
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c as Range
Dim finde as String
finde = Cells(1, Target.Column)
With Worksheets("Schichteinteilung")
Set c = .Rows(1).Find(What:=finde, LookIn:=xlValues)
If .Cells(Target.Row, c.Column).Value = "U" Or .Cells(Target.Row, c.Column).Value = "FU" Then
MsgBox .Cells(Target.Row, c.Column).Value
End If
End With
Set c = Nothing
End Sub

gruss hary

Gerd1
31.08.2010, 17:37
Hallo Harry,
Danke für deine Antwort
habs gerade erst gesehen - wurde diesmal garnicht per EMail benachrichtigt -
Ich habe gerade einmal kurz getestet und ich glaube, es ist genau das was ich wollte.
Werde es heute Abend in meine Originalmappe einfügen und nocheinmal testen.
Ich gebe auf jeden Fall nocheinmal ein Feedback zu deiner Arbeit.

Danke vielmals

Gerd

Gerd1
31.08.2010, 20:49
Hallo Harry,
der Code von dir macht genau das was ich haben wollte - soweit Tadellos.
Nun brauche ich den Code so das ich mehrere Tabellen durchsuchen kann, denn es gibt mehrere Arbeitsgruppen wo die Namen zu finden sind.
Beispiel: Name1 steht in Schichteinteilung und Name2 steht in Tabelle2 u.s.w..
Ich habe deinen Code ergänzt und bekomme jetzt immer die Fehhlermeldung With Blockvariable nicht deklariert.
Was mache ich hier falsch?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ArTabellen() As String
Dim i As Integer
Dim c
Dim finde
ArTabellen() = Split("Schichteinteilung,Tabelle1,Tabelle2", ",")
finde = Cells(1, Target.Column)
For i = LBound(ArTabellen) To UBound(ArTabellen)
With Worksheets(ArTabellen(i))
'With Worksheets("Schichteinteilung")
Set c = .Rows(1).Find(What:=finde, LookIn:=xlValues)
If .Cells(Target.Row, c.Column).Value = "U" Or .Cells(Target.Row, c.Column).Value = "FU" Then
MsgBox .Cells(Target.Row, c.Column).Value
End If
End With
Next
End Sub

hary
01.09.2010, 08:52
Hallo Gerd
versuchs mal hier mit.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet
Dim rng As Range
Dim suchbegriff As String
suchbegriff = Cells(1, Target.Column).Value
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Prüfung" Then
With ws.Rows(1)
Set rng = .Find(suchbegriff, LookIn:=xlValues)
If Not rng Is Nothing Then
If .Cells(Target.Row, rng.Column).Value = "U" Or .Cells(Target.Row, rng.Column).Value = "FU" Then
MsgBox .Cells(Target.Row, rng.Column)
exit sub
End If
End If
End With
End If
Next ws
set rng = nothing
End Sub
gruss hary

Gerd1
01.09.2010, 14:23
Hallo Harry,
die von dir angebotene Lösung ist klasse und funktioniert super.
Zwar hätte ich gerne meinen Ansatz vervollständigt, weil ich dort die Tabellen angeben kann die durchsucht werden sollen, denn im verlauf des Jahres wird es auch Tabellen mit doppelten Inhalt also Sicherungen der Originale geben.
Wenn ich nun die Originale weiterbearbeite kommt es zwangsläufig zu einem Fehler bzw. zu einer doppelten Meldung.
Aber fürs erste ist die Lösung von dir toll und ich Danke dir für deinen Einsatz.

Gerd

hary
01.09.2010, 14:41
Hallo Gerd
mal ungetestet.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ArTabellen() As String
Dim i As Long
Dim c As Range
Dim finde
finde = Cells(1, Target.Column)
ArTabellen() = Split("Schichteinteilung,Tabelle1,Tabelle2", ",")
For i = LBound(ArTabellen) To UBound(ArTabellen)
With Worksheets(ArTabellen(i))
Set c = .Rows(1).Find(What:=finde, LookIn:=xlValues)
If Not c Is Nothing Then
If .Cells(Target.Row, c.Column).Value = "U" Or .Cells(Target.Row, c.Column).Value = "FU" Then
MsgBox .Cells(Target.Row, c.Column).Value
End If
End If
End With
Next
End Sub

gruss hary

Gerd1
01.09.2010, 14:54
Hi Harry,
funktioniert leider auch nicht, jetzt kommt der Fehler "Index außerhalb des gültigen Bereichs".

Gerd

hary
01.09.2010, 15:01
Hallo Gerd
anbei im Anhang die Testmappe. Name aaa habe ichmal nach Tabelle3 gebracht. bei Doppelklick in Prüfung (aaa) erscheint nichts.Tabelle3 wird nicht geprueft. Aendere dann mal in Tabelle1 die eee in aaa und pruefe nochmal. Dann wird angezeigt.
gruss hary

Gerd1
01.09.2010, 15:10
Hi Harry,
du hast recht, in der Testmappe funktioniert das ganze einwandfrei.
Ich werde noch einmal meine Originalmappe durchsehen und melde mich dann nocheinmal.

Danke Harry!

Gerd1
01.09.2010, 15:24
Hi Harry,
verstehen kann ich es nicht, aber ich habe den Code nocheinmal rausgelöscht und wieder eingefügt - und siehe da es funktioniert auch in meiner Originalmappe.
Ich danke dir herzlich für deine Geduld und Mühe - Toll das ihr hier im Forum seid.

DANKE!!!

hary
01.09.2010, 15:41
Hallo
Na denn, Danke fuer die Rueckmeldung.
gruss hary