Office: Datenbank filtern

Hallo zusammen,

hab hier eine Excel- Mitarbeiterdatenbank (Anrede, Titel, Name, Vorname, Standort, Abteilung;...)

Nun will ich aus diesen Daten mehrere Listen kreieren, z.B. eine Liste, die alle Mitarbeiter von mehreren Abteilungen auflistet. Dabei brauch ich in der Liste aber nur bestimmte Felder, nicht den Ganzen Datensatz (z.B. nur Anrede und Name)
Die Listen sollen sich immer automatisch aktualisieren, ich will nicht von Hand irgendwelche Filter setzen.
Kriegt man das mit Formeln/Funktionen hin oder braucht man da ein Makro? Vielleicht ist das auch ganz einfach und ich steh einfach nur auf dem Schlauch...

Danke schonmal...

Gruß Biedle

Excel 2003
Windows XP Professional

 

Hallo Biedle,

ganz einfach geht das sicher nicht, also auf dem Schlauch stehst du nicht. Das klingt eigentlich mehr nach einem Thema für Access. Eine Datentabelle und mehrere Abfragen die je nach Filter bestimmte Datensätze anzeigen.

In Excel ist so was eher schwierig zu realisieren, dazu brauchst Du vermutlich einige Makros.

Kennst Du dich mit Access aus?

Gruß
Michael

 

Mit Access kenne ich mich kaum aus. Ausserdem soll das von mehreren Arbeitsplaetzen funktionieren (Nicht gleichzeitig) und da ist nicht ueberall Access installiert. Dann muss ich es wohl mit makros loesen.. Danke schonmal.

 

Hallo Biedle,

das ist sowohl mit Formeln (nachteilig, da sehr Speicherintensiv) als auch mit Makros (relativ simpel) zu lösen.

Gib mir eine Beispielmappe und ich deine konkreten Vorstellungen der zu erstellenden Listen und ich helfe dir.

 

Hallo fridgenep,

Schon mal Danke für dein Angebot, mir zu helfen.
Angehängt hab ich die Datei Mitarbeiterdatenbank.xls

Auf dem Tabellenblatt 1 werden die Mitarbeiter nacheinander unsortiert eingetragen.
Auf den anderen Tabellenblättern sollen dann die Abfragen sein. Auf dem Tabellenblatt "Mitarbeiterliste Musterhausen" sollen alle Mitarbeiter in Musterhausen aufgelistet werden, möglichst alphabetisch sortiert.

"Verteiler": hier sollen die Mitarbeiter in Spalte C durch Komma getrennt eingetragen werden (entsprechend ihrer Zuordnung zum QMH-Ordner in Spalte A)

 

Hallo Biedle,

sorry wegen der Verspätung.

Schau es dir einfach mal an....

 

Danke fridgenep, danke danke danke!!!

so hab ich mir das vorgestellt.

und wie funktioniert das jetzt? hab kein Makro gefunden und formeln zeigt es auch nicht an ??????

würde das ganze gerne noch selbst ausbauen, wenn ich wüsste wie das jetzt genau gemacht ist.


nochmals danke

gruss
Biedle

 

Hallo Biedle,

die Makros liegen direkt hinter den entsprechenden Tabellenblättern:

Tabelle "Mitarbeiterliste Musterhausen"

Code:

Option Explicit

Private Sub Worksheet_Activate()
        Application.ScreenUpdating = False
        Sheets("Liste").Columns("A:G").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("B1"), Unique:=False
        Columns("G:H").Delete
        Columns("B:F").Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("D2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
        Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Deactivate()
        Columns("B:F").Delete
End Sub

Tabelle "Verteiler"

Code:

Option Explicit

Private Sub Worksheet_Activate()
    Dim lngVerteiler    As Long
    Dim lngListe        As Long
    Dim lngI            As Long
    Dim lngX            As Long
    Dim strText         As String
    lngVerteiler = Range("A65536").End(xlUp).Row
    lngListe = Worksheets("Liste").Range("I65536").End(xlUp).Row
 Application.ScreenUpdating = False
    Worksheets("Liste").Columns("I:I").AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("A1"), Unique:=True
    Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  For lngI = 2 To lngVerteiler
    For lngX = 2 To lngListe
       If Worksheets("Liste").Cells(lngX, 9).Value = Cells(lngI, 1) Then
            If strText = "" Then
                strText = Worksheets("Liste").Cells(lngX, 4).Value
            Else
                strText = strText & "," & Worksheets("Liste").Cells(lngX, 4).Value
            End If
        End If
    Next lngX
    Cells(lngI, 2).Value = strText
    strText = ""
  Next lngI
    Columns("B").AutoFit
 Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Deactivate()
Columns("B").Delete
End Sub

 

Danke,
da hätt ich gleich drauf kommen können, hab schon lange nicht mehr mit Makros gearbeitet. Jetzt ist es erstmal soweit klar. wenn ich weitere Probleme habe, meld ich mich...

DANKE!!!!!

 

so bin jetzt schon ein Stückchen weiter,
Die Mitarbeiterlisten hab ich jetzt fertig und funktionieren auch.
Deshalb hab ich sie im Anhang gleich rausgeschmissen.
Am Verteiler hab ich auch ein bisschen was geändert. Jetzt krieg ich aber eine Fehlermeldung und weiss nicht warum...

Gruß Biedle

 

Hallo Biedle,

probier mal:

Code:

Option Explicit

Private Sub Worksheet_Activate()
    Dim lngVerteiler    As Long
    Dim lngListe        As Long
    Dim lngI            As Long
    Dim lngX            As Long
    Dim strText         As String
 Application.ScreenUpdating = False
    Worksheets("Liste").Columns(9).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("A1"), Unique:=True
    Columns(1).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    lngVerteiler = Range("A65536").End(xlUp).Row
    lngListe = Worksheets("Liste").Range("I65536").End(xlUp).Row
  For lngI = 2 To lngVerteiler
    For lngX = 2 To lngListe
       If Worksheets("Liste").Cells(lngX, 9).Value = Cells(lngI, 1) Then
            If strText = "" Then
                strText = Worksheets("Liste").Cells(lngX, 1).Value & " " & Worksheets("Liste").Cells(lngX, 3).Value
            Else
                strText = strText & ", " & Worksheets("Liste").Cells(lngX, 1).Value & " " & Worksheets("Liste").Cells(lngX, 3).Value
            End If
        End If
    Next lngX
    Cells(lngI, 2).Value = strText
    strText = ""
  Next lngI
    With Columns(2)
        .ColumnWidth = 60
        .WrapText = True
    End With
    Rows("1:250").EntireRow.AutoFit
 Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Deactivate()
Columns(1).Delete
End Sub

 

SUPER!!!!!!!!!!!!!!!! :-D :mrgreen:
Klappt. Danke.

Der Verteiler soll nun Teil eines Anschreibens werden. Bisher ist das Anschreiben in Word. Beim Erstellen eines neuen Anschreibens will ich auswählen können, wer das Anschreiben bekommt (durch auswahl des QM-Ordners). Das Anschreiben soll dann in einer separaten Datei gespeichert werden.
Nun meine Frage, wie ich das am besten angehe. Ich sehe da 2 Möglichkeiten:
1. Konvertierung des Anschreibens in Excel und dann ausfüllen per Makro.
2. Direktes Ausfüllen in Word (Der Verteiler sitzt in einer Tabelle im oberen Bereich des Dokumentes).

Das ganze soll natürlich möglichst einfach zu bedienen sein. :-D

gruss
Biedle

 

Hallo,

setze in dem Workdokument eine Textmarke an der Stelle, wo der Verteiler rein soll. Oder eine Formular-Feld (kannst dir aussuchen). Aber ich denke eine Textmarke sollte reichen.

Von Excel aus, kannst du dann den String des gewählten QM-Ordners an die Textmarke des Word-Dokument übergeben.

 

Hallo Fridgenep,

Danke für die schnelle Antwort. Prinzipiell weiss ich jetzt die Vorgehensweise. die Textmarken hab ich erstellt. wie krieg ich jetzt die Daten in Word? da muss ich ja zunächst die Datei über ein Makro öffnen und dann den Wert übergeben.
Edit: wie heisst die Funktion? so ein Codeschnipsel würde mir reichen.

Ausserdem bin ich noch am überlegen, wie ich die QM-Ordner (eigentlich immer mehrere) auswähle.
Am liebsten würde ich es über eine UserForm (mit Checkboxen o.ä.) machen, wichtig ist, dass ich mehrere Ordner auswählen kann. Die Namen der Ordner werden zwar gleich bleiben, aber es kann sein das hin und wieder noch zusätzliche hinzukommen und dann müsste ich ja die UserForm erst noch ändern. kann man eine UserForm per Makro erstellen?


Fragen über Fragen...

Gruß Biedle