|
Servus!
Beim Auswerten der Daten meiner Diplomarbeit sind ich und mein Betreuer auf ein Problem gestoßen um welches ich mich jetzt ohne wirkliche informatische Vorkenntnisse kümmern darf. Ich wäre um jede Hilfe höchst erfreut!
Und zwar geht es darum einen Code zu schreiben um einzelne Zahlen aus hunderten Textdokumenten herauszulesen und automatisch in eine Excel Tabelle einzufügen. Bisher habe ich es geschafft ein Makro zu erstellen, welches mir den Text aus dem Dokument ausliest und an den richtigen Stellen einfügt. Nun habe ich aber leider keine Ahnung wie ich vorgehen soll um etwas zu schreiben, das mir diesen Vorgang mit allen Dokumenten durchführt (Loop?).
Vielen Dank für Eure Hilfe im Vorhinein!
Lg Sebastian
Hier noch das Makro zum Auslesen:
Sub Datenimport()
'
' Datenimport Makro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Böhlers\Desktop\Analyse\081.par", Destination:=Range("$B$3"))
.Name = "081"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 19
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("B3:B312").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-300
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("B3:B312").Select
Selection.ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Böhlers\Desktop\Analyse\081.par", Destination:=Range("$LA$3"))
.Name = "081"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 19
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("LA3:LA312").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-300
Range("LB3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("LA3:LA312").Select
Selection.ClearContents
End Sub
|