AW: Zellen generieren und als Liste transformieren
23.03.2007 21:29:00
fcs
Hallo Andy,
hier das entsprechende Makro für den Transfer der Daten aus den Einzelnen Blättern in die Zusammenfassung. Mit den eingefügten Erläuterungen solltets du die notwendigen Ergänzungen/Erläuterungen machen könne.
Zur Anwendung nach dem Einrichten des Makros in der Persönlichen Makro-Arbeitsmappe einfach die zu bearbeitende Datei öffnen und das Makro starten.
Literatur zu VBA:
Da ich sehr viel mit "Learning by doing", suchen in diesem und anderen Foren und intensiver Nutzung der Excel-Hilfe arbeite kann ich dir nur bedingt Literatur empfehlen.
Als preiswerte Zusatzinfo für 4.40 habe ich mir mal "VBA mit Excel .. für Versionen 200-2003" vom KnowWare-Verlag in einer Bahnhofbuchhandlung besorgt. Infos siehe http://www.knowware.de/?cat=1.2&book=excelvba
Ein 70-Seiten Heft, das viele grundlegende Problemstellungen und Programmiertechniken unter VBA beschreibt mit vielen kleinen Code-Beispielen und Erläuterungen. Für VBA-Einsteiger sicherlich hilfreich.
Ansonsten hier mal den Button "Offline-Excel/VBA-Buch" anklicken und weiter zum Wikibooks oder auch die anderen Angebote von Hans W. Herber testen.
Gruß
Franz
Sub AuslesenTabellen()
Dim wb1 As Workbook, wksQuelle As Worksheet, wksZiel As Worksheet
Dim BlattName As String
Dim Zeile As Long, arrQuellZellen, arrZielSpalten, Spalte As Integer
Set wb1 = ActiveWorkbook
BlattName = InputBox("Name des Tabellenblatts mit der zusammengefassten Liste:", _
"Daten zusammenfassen", "Zusammenfassung")
'Prüfen ob Blatt mit diesem Namen bereits existiert
For Each wksQuelle In wb1.Sheets
If wksQuelle.Name = BlattName Then
If MsgBox("Es existiert bereits ein Blatt mit dem Namen '" & BlattName & vbLf & vbLf _
& "Sollen die Daten überschrieben werden?", vbQuestion + vbYesNo, _
"Datenzusammenfassung erstellen") = vbYes Then
Set wksZiel = wksQuelle
wksZiel.Activate
'Inhalte im Vorhandenen Blatt löschen
wksZiel.Cells.Clear
GoTo weiter1
Else
Exit Sub
End If
End If
Next
'Tabellenblatt für Liste vor dem 1. Blatt einfügen
wb1.Worksheets.Add Before:=wb1.Sheets(1)
Set wksZiel = ActiveSheet
wksZiel.Name = BlattName
weiter1:
Zeile = 1 'Zeile mit den Spaltentiteln
'Für weitere Zellen die Arrays in den folgenden Zeilen Anpassen/Ergänzen
'Array der Zellen, die ausgelesen werden sollen
arrQuellZellen = Array("B12", "B22", "B45", "B77")
'Array der Spalten in der Liste in die die Werte aus den Zellen geschrieben werden sollen
arrZielSpalten = Array(2, 3, 4, 5)
'Array der Spaltentitel in der Liste
arrTitel = Array("Tabellenname", "Titel 1", "Titel 2", "Titel 3", "Titel 4")
With wksZiel
'Spaltentitel in Zusammenfassung eintragen
For Spalte = LBound(arrTitel) To UBound(arrTitel)
.Cells(Zeile, Spalte + 1) = arrTitel(Spalte)
Next Spalte
'Fenster unterhalb Titelzeile fixieren
.Cells(Zeile + 1, 1).Select
ActiveWindow.FreezePanes = True
'Tabellenblätter auslesen
For Each wksQuelle In wb1.Worksheets
If wksQuelle.Name wksZiel.Name Then
Zeile = Zeile + 1
'Tabellenname in Spalte A eintragen
.Cells(Zeile, 1).Value = wksQuelle.Name
For Spalte = LBound(arrQuellZellen) To UBound(arrQuellZellen)
'Zahlenformat der Zelle übertragen
.Cells(Zeile, arrZielSpalten(Spalte)).NumberFormat = _
wksQuelle.Range(arrQuellZellen(Spalte)).NumberFormat
'Wert der Zelle übertragen
.Cells(Zeile, arrZielSpalten(Spalte)).Value = _
wksQuelle.Range(arrQuellZellen(Spalte)).Value
Next Spalte
End If
Next wksQuelle
'Spaltenbreiten auf optimalen Wert setzen
.UsedRange.EntireColumn.AutoFit
End With
End Sub