Makroerweiterung
11.02.2008 17:19:56
christian
Ich bekomme zu oft Daten, die wirr durcheinander sind. nun möchte ein makro in mein bestehendes makro einbauen, mit dem ich die Rohdaten (.txt-files) (siehe Link) vor dem Import ins Excel sortieren kann.
https://www.herber.de/bbs/user/49817.txt
Ich stelle mir das etwa so vor: ich habe ein makro, mit dem ich die unzähligen txt-files zu einer txt zusammenfügen kann und zusätzlich einen zusatzwert erfasse. zuvor müsste ich jedoch die daten ordnen können:
1. muss das makro eine spalte vor den der spalte # einfügen mit der überschrift "Name"
2. für jede zeile muss der "Name" erfasst werden können
(da meist mehrer zeilen den gleichen namen erhalten, weil diese messwiederholungen sind, wäre irrgend eine vereinfachung wünschenswert. vielleicht eine tabelle mit allen möglichen namen hinterlegen um dann nur noch ein kreuz zu setzten....?)
3. möchte ich die zeilen nach "Namen" ordnen. Alphabetisch oder nach nummer geht leider nicht da die "Namen" sehr abstrakt sind und keine logik haben. eine zweisung an eine position wäre das ziel.
4. in meinem bestehende makro werden unzählige txt-files zusammengefügt. da alle gleich aufgbaut sind (1n entpricht immer demselben "Namen") sollte schritt 1.-3. automatisch für alle weiteren txt übernommen werden.
# IDV %* AREA AVG BACK
1n 5439545 6.4 346 15721 2495
2n 4485423 5.3 346 12964 3063
3n 4679466 5.5 346 13524 2403
4n 2284790 2.7 346 6603 25620
5n 1776730 2.1 346 5135 25471
mein bestehendes makro:
Sub MergeFiles(SourceFolder As String, OutputFile As String)
'Zusammenfügen nummerierter .txt Dateien in aufsteigender Richtung
Dim i As Integer
Dim Textzeile As String
Dim Dateiname As String
Dim numOut As Integer
Dim numIN As Integer
Dim strNum As String, n As Integer
numOut = FreeFile
Open SourceFolder & OutputFile For Output As #numOut
Dateiname = Dir(SourceFolder & "*.txt")
Do While Not Dateiname = ""
If Dateiname OutputFile Then
n = 0
numIN = FreeFile
strNum = InputBox("Aktuelle Datei: " & Dateiname & Chr(13) & Chr(10) & "Bitte Anzahl _
Sporen oder DNA-Konzentration erfassen:", "Zusatz", "")
Open SourceFolder & Dateiname For Input As #numIN 'Öffne gefundene Datei
Do While Not EOF(numIN) 'Schleife bis Dateiende.
Line Input #numIN, Textzeile 'Zeile in Variable einlesen.
n = n + 1
If n = 3 Then 'einfügen in Zeile 3
Textzeile = Textzeile & Chr(32) & strNum
End If
Print #numOut, Textzeile 'Ausgabe in Datei.
Loop
Close #numIN
End If
Dateiname = Dir
Loop
Close #numOut
End Sub
Sub Import_TXT(Filename As String, Position As String, DatenBereich As String)
' B1 B:H
Range(DatenBereich).Select
Selection.ClearContents
MsgBox "DataRange: " & DatenBereich & " deleted!"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Filename, Destination:=Range( _
Position))
.Name = Filename
.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 = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(6, 12, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
was meint ihr, ist sowas überhaupt möglich? kann mir jemand weiterhelfen?
besten dank und gruss
Christian