expertenaustausch > microsoft.* > microsoft.excel

Jens Nasse (24.07.2004, 10:31)
Hallo NG !

Ich stehe vor einem Problem, bei dem ich partout nicht weiss, wie ich es
lösen soll.

Ich nutze Excel für die Vereinsverwaltung.
Die Mitglieder sind je nach Wohnort in verschiedene Bereiche Unterteilt.
Nun brauche ich Berichte für jeden einzelnen "Wohnbereich".

Bisher habe ich immer alle Mitglieder eines Wohnbereiches "von Hand" auf ein
anderes Blatt kopiert.

Wie kann ich dies automatisieren ?

Wenn sich nur die Daten der Mitglieder ändern würden, könnte ich ja feste
Bereiche zur Datenübernahme festlegen - aber leider kommen ja in jedem
Bereich neue Mitglieder hinzu und dann würde die feste Zuornung nicht mehr
klappen.

Bitte helft mir.

Vielen Dank im Voraus

Jens
Herbert Taferner (24.07.2004, 18:11)
Hallo Jens,

beschreibe mal wie die Daten aussehen, was wo steht,
und wie die Wohnbereiche heißen bzw. sind die Namen
der Tabellen dann identisch mit den Namen der Wohnbereiche
sind die Daten sortiert oder nicht,
sollen die Daten nach dem aufteilen sortiert sein,
wenn ja nach welchen Kriterien

mfg Herbert
Jens Nasse (26.07.2004, 23:05)
Kein Problem.

Die Tabelle besteht aus folgende Spalten:
A - lfd. Nummer, bei Sortierung nach Wohnbereich, Nachname und Vorname -
jeweils aufsteigend in dieser Reihenfolge.
B - Mitgliedsnummer (eine 11-stellige Nummer, mit Vorstehender "0")
C - Wohnbereich (eine Ziffer, nach der nachher auch die Mitglieder den
"Unterlisten" der Arbeitsmappe zugeordnet werden sollen)
D - Nachname
E - Vorname
F - Geburtsdatum
G - Vorname Partner
H - Geburtsdatum Partner
I - Straße
J - PLZ
K - Ort
L - Telefonnummer
M - Eintrittsdatum
N - Hochzeitsdatum
O - Bemerkung

In Zeile 1 Befindet sich der Spaltentitel ab Zeile 2 beginnen die Daten.
Unten drunter ist noch eine kleine Tabelle, die die Menge der Einträge zu
jedem Wohngebiet zählt.
> z.B X Mitglieder aus Wohnbereich 1 - diese kann ich aber auch auf ein seperates Unterblatt verschienben, wenn sie hier stört.


Die Mitglieder aus Wohnbereich 1, 2 oder 3 sollen später jeweils auf einem
seperaten Arbeitsblatt zu finden sein - das ist ja mein Kernproblem .oO(
Versteht das einer ? :) )

Hoffe, das reicht Dir.

LG
Jens
Herbert Taferner (27.07.2004, 12:38)
Hallo Jens,

versuche es mal damit,
normalerweise brauchst du nur das Makro
"Bereich_übertragen".
Da ich aber nicht sicher bin
ob du die Tabelle sortiert hast,
bzw. die einzelnen Tabellen für die
Wohnbereiche schon bestehen
habe ich ein paar Zeilen angefügt

die Funktionsweise sollte so sein,
du gibst im Makro "Ablauf"
die Eckdaten bekannt

z. B.
unter Anzahl
die Zahl der verschiedenen Wohnbereiche
unter neuerName
den Namen den diese Tabellen erhalten sollen
unter Blatt
den Namen der Tabelle wo die Daten jetzt stehen

wenn du dann das Makro Ablauf startest
wird anhand deiner eingegebenen Eckdaten
geprüft ob die Tabellen schon bestehen
wenn nicht werden sie erzeugt.

dies hat noch dazu den Vorteil das sie aus einer
Kopie der Grundtabelle erzeugt werden und
dadurch auch die Formate erhalten bleiben

wenn diese schon bestehen wird die Grundtabelle
sortiert nach Spalte D dann E und dann F
anschließend nach der Anzahl der Wohnbereiche
gefiltert und die jeweiligen Daten dorthin übertragen

du kannst die Grundtabelle belassen wie sie ist,
auch wenn später einmal Daten hinzugefügt werden
brauchst du nur das Makro "Ablauf"
anwerfen und die Daten werden dadurch wieder
alle aktualisiert.
Wenn in der Grundtabelle ein Datensatz gelöscht wird
dann den Ablauf einfach wiederholen.

da bei jedem Durchlauf die Bereichstabellen geleert
werden und wieder neu befüllt, bist du dadurch
immer am aktuellen Stand

dies in ein Modul kopieren
'---------------------------------------------------
Option Explicit

Public neuerName As String
Public Blatt As String
Public Anzahl As Integer

Sub Ablauf()

Anzahl = 3
' Anzahl der Wohnbereiche
neuerName = "Wohnbereich_"
' Name der Einzeltabellen
' z. B. "Wohnbereich_1"
Blatt = "Tabelle1"
' Name der Ausgangstabelle
' von der die Daten kommen

Application.ScreenUpdating = False

Blätter_anlegen
sortieren
Bereich_übertragen

Application.ScreenUpdating = True

End Sub

Sub Bereich_übertragen()
Dim i As Integer
Dim Lz As Long

With Worksheets(Blatt)
.Range("A1").AutoFilter
For i = 1 To Anzahl
.Activate
Selection.AutoFilter Field:=3, Criteria1:=i
Lz = .Cells(Rows.Count, 1).End(xlUp).Row
.Rows("1:" & Lz).Copy
With Worksheets(neuerName & i)
.Range("A1:IV65536").Value = ""
.Range("A1").PasteSpecial
Application.CutCopyMode = False
.Activate
.Range("A1").Select
End With
Next i
.Activate
Selection.AutoFilter
End With
End Sub

Sub sortieren()

Dim Lz As Long

With Worksheets(Blatt)
Lz = .Cells(Rows.Count, 1).End(xlUp).Row
.Activate
.Range("A1:O" & Lz).Sort Key1:=Range("D2"), _
Order1:=xlAscending, Key2:=Range("E2"), _
Order2:=xlAscending, Key3:=Range("F2"), _
Order3:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End Sub

Sub Blätter_anlegen()

Dim i As Integer

For i = 1 To Anzahl
If Not SheetExists(neuerName & i) Then
Worksheets(Blatt).Select
Worksheets(Blatt).Copy after:=Worksheets(Sheets.Count)
ActiveSheet.Name = neuerName & i
End If
Next i

End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(strName) Is Nothing
End Function
'---------------------------------------------------

mfg Herbert
Ähnliche Themen