Makro zum Aufbau einer Rohdatendatei
21.03.2016 09:44:54
Paulinchen
da ich auf dem Gebiet von VBA noch ein ziemlicher Anfänger bin benötige ich eure Hilfe:)
Es geht darum, mit Hilfe eines Makros aus einer Excel-Datei eine neue Excel Liste aufzubauen.
Das ganze sieht so aus. Ich habe eine "Maske/Formular" in Excel aufgebaut, die Maske kann jedoch vom Umfang des Inhalts variieren. Es kann eine unterschiedliche Anzahl an Blöcken mit unterschiedlich großen Umfang vorhanden sein. Allerdings soll die Form der Maske immmer gleich sein. Nun will ich mit Hilfe eines Makros, alle Daten aus dieser Maske ziehen und eine Art Rohdaten Registerblattlatt aufbauen. (Ich habe das mal in der beigefügten Datei ("Maskenmakro")
Bei dem Makro soll zuerst das Tabellenblatt angegeben werden, auf welches das Makro zugreifen soll. (zum Beispiel mit einer Inputbox). Dann alle Übrschriften aus der Maske nebeneinander in der Rohdatentabelle darstellen und dann entsprechend die Daten aus der Maske zuteilen.
Desweiteren soll die Rohdatentabelle kontinuierlich weiter gefühlt werden, das heißt die Tablle soll sich nicht immer wieder neu überschreiben.
Ich hoffe ihr könnt mir weiterhelfen. Da es für mich als neulig schon eine ordentliche Mammut-Aufgabe ist.
Anbei auch noch mein bisheriger Code:
Sub Makro1()
Dim Blocknumber As String
Dim Suchzelle As Range
Dim Register As String
Dim i As Integer
Dim Wordblock As String
Dim a As Integer
Dim Zeile As String
Dim Spalte As String
Dim Kopierbereich As Range
Register = InputBox("Enter a worksheet name")
Blocknumber = InputBox("Enter number of Blocks value")
Wordblock = "Block"
i = 0
Do While i "" Then
With Sheets(Register).Range("A:A")
Set Suchzelle = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Suchzelle.Select
Zeile = ActiveCell.Row
Spalte = ActiveCell.Column
MsgBox (Zeile & Spalte)
Set Kopierbereich = Range(Cells(Zeile, 1), Cells(Zeile, 15))
Kopierbereich.Copy
Sheets("Test").Select
Sheets("Test").Activate
Cells(a, 1).PasteSpecial
If Not Suchzelle Is Nothing Then
Application.Goto Suchzelle, True
Else
MsgBox "Nothing found"
End If
End With
End If
Loop
End Sub
Mein Gedanke bei meinem Code ist, dass zuerst nach der Anzahl der Blöcke in der Maske gefragt wird und das Tabellenblatt angegben wird, auf das zugegriffen werden soll. Desweiteren soll dann mit Hilfe einer schleife zuerst die Überschrift der Blöcke in meine Zieldatei übertragen werden usw.
Leider hakt es bei mir schon bei der ersten Suche nach den Blöcken. Daher hoffe ich auf eure Hilfe. Für andere Lösungsansätze bin ich natürlich auch offen und hoffe, dass die angehängte Exceldatei erste Fragen zum aufbau der Datei beantwortet.
Vielen Dank schonmal!!!!
Hier die hochgeladene Datei:
https://www.herber.de/bbs/user/104489.xlsm