AW: einfachere Zuodnung ?
17.03.2010 21:54:17
fcs
Hallo Hans,
ein Ansatzt wäre einen Pivot-Tabellenbericht zu erstellen
Zeilenfelder:
- Straßenzuordnungsnummern
- Bezirkszugehörigkeit
- Straßenname
- Reinigungsklasse
Spaltenfelder:
- Objekt
- Reinigungstag
Datenfeld:
- Objekt - ist aber beliebig
Alle Zeilen und Spaltenfelleder so einrichten, dass keine Zwischenergebnisse angezeigt werden.
Dann erhälst du pro Strassenzuordnung eine Zeile. Per Formel dann ggf. die Wochentage pro Objekt zusammenbasteln. Sind aber im noch relativ mühsehlig zu erstellende Formeln.
Alternativ die Umgruppierung der Daten per Makro. Für das nachfolgende Makro müssen die Daten vor dem Makrostart nach der Strassenzuordnungsnummer sortiert sein.
Gruß
Franz
'Erstellt unter Excel 2007, Windows Vista
'fcs - 2010-03-17
Sub TabelleUmorganisieren()
Dim wksQuelle As Worksheet, WksZiel As Worksheet
Dim ZeileQ As Long, ZeileZ As Long
Dim StrassenZONr As Long, Bezirk$
Dim Strassenname$, Reinigungsklasse$
Dim sTageFahrbahn$, sTageRadweg$, sTageGehweg$
Set wksQuelle = Worksheets("Tabelle1") 'Basis-Datentabelle
'Ergebnis-Tabelle neu anlegen
Set WksZiel = Worksheets.Add(after:=Sheets(ActiveWorkbook.Sheets.Count))
ZeileZ = 1 'Zeile mit Spaltentiteln in Zieltabelle - ggf. anpassen
'Spaltentitel eintragen - ggf. anpassen
With WksZiel
.Cells(ZeileZ, 1).Value = "Strassenzuordnungsnummern"
.Cells(ZeileZ, 2).Value = "Bezirk"
.Cells(ZeileZ, 3).Value = "Straßenname"
.Cells(ZeileZ, 4).Value = "Reinigungsklasse"
.Cells(ZeileZ, 5).Value = "Objekt Fahrbahn"
.Cells(ZeileZ, 6).Value = "Objekt Gehweg"
.Cells(ZeileZ, 7).Value = "Objekt Radweg"
'Fenster unter SPaltentiteln fixieren
Cells(ZeileZ + 1, 1).Select
ActiveWindow.FreezePanes = True
End With
With wksQuelle
ZeileQ = 2 'Nummer der Zeile unter den Spaltentiteln in Basis-Tabelle - ggf. anpassen
'Aus 1. Datensatz Basisdaten einlesen
StrassenZONr = .Cells(ZeileQ, 1).Value
Bezirk = .Cells(ZeileQ, 2).Value
Strassenname = .Cells(ZeileQ, 3).Value
Reinigungsklasse = .Cells(ZeileQ, 4).Value
For ZeileQ = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Strassenzuordnungsnummer vergleichen
If StrassenZONr .Cells(ZeileQ, 1) Then
'Werte in Zieltabelle eintragen
With WksZiel
ZeileZ = ZeileZ + 1
.Cells(ZeileZ, 1).Value = StrassenZONr
.Cells(ZeileZ, 2).Value = Bezirk
.Cells(ZeileZ, 3).Value = Strassenname
.Cells(ZeileZ, 4).Value = Reinigungsklasse
.Cells(ZeileZ, 5).Value = sTageFahrbahn
.Cells(ZeileZ, 6).Value = sTageGehweg
.Cells(ZeileZ, 7).Value = sTageRadweg
End With
'nächste Basisdaten einlesen
StrassenZONr = .Cells(ZeileQ, 1).Value
Bezirk = .Cells(ZeileQ, 2).Value
Strassenname = .Cells(ZeileQ, 3).Value
Reinigungsklasse = .Cells(ZeileQ, 4).Value
sTageFahrbahn = ""
sTageGehweg = ""
sTageRadweg = ""
End If
'Objekt prüfen und Reinigungstag einlesen
Select Case .Cells(ZeileQ, 6) 'Objekt prüfen
Case "Fahrbahn"
If sTageFahrbahn = "" Then
sTageFahrbahn = .Cells(ZeileQ, 5)
Else
sTageFahrbahn = sTageFahrbahn & ", " & .Cells(ZeileQ, 5)
End If
Case "Gehweg"
If sTageGehweg = "" Then
sTageGehweg = .Cells(ZeileQ, 5)
Else
sTageGehweg = sTageGehweg & ", " & .Cells(ZeileQ, 5)
End If
Case "Radweg"
If sTageRadweg = "" Then
sTageRadweg = .Cells(ZeileQ, 5)
Else
sTageRadweg = sTageRadweg & ", " & .Cells(ZeileQ, 5)
End If
End Select
Next ZeileQ
'Letzte Werte in Zieltabelle eintragen
With WksZiel
ZeileZ = ZeileZ + 1
.Cells(ZeileZ, 1).Value = StrassenZONr
.Cells(ZeileZ, 2).Value = Bezirk
.Cells(ZeileZ, 3).Value = Strassenname
.Cells(ZeileZ, 4).Value = Reinigungsklasse
.Cells(ZeileZ, 5).Value = sTageFahrbahn
.Cells(ZeileZ, 6).Value = sTageGehweg
.Cells(ZeileZ, 7).Value = sTageRadweg
.Columns.AutoFit
End With
End With
End Sub