makro zum datei importieren und individueller wert
07.02.2008 09:17:33
christian
folgendes problem bereitet mir kopfzerbrechen: ich habe ein makro, das mir .txt dateien zusammenfügt zu einer einzigen .txt datei. ein zweites makro importiert mir diese einzige datei in ein excelfile. funktioniert perfekt! nun sollte beim 1. oder 2. makro eine funktion eingebaut werden, dass ein ich einen wert (zahl) in einer box erfassen kann und dieser wert soll zum entsprechenden .txt in einer zeile oder einer weiteren spalte angefügt werden.
so sehen die einzelnen .txt dateien aus die zusammengefügt werden (haben aber bis zu 100n). nun wäre es wichtig, dass ich irrgendwo zu diesem txt ein zahlenwert erfasst werden kann. und wenn ich 20 txtfiles zusammenfüge dann muss ich zu jedem einzelnen ein solcher zahlenwert erfasst werden können. toll wäre wenn jedesmal ein box aufgeht um den zahlenwert zu erfassen.
Black is 0, White is 255
# IDV %* AREA AVG BACK (z.b. Zahlenwert hierher)
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
IDV=Integrated Density Value s=standard
* based on Integrated Density Value
und so sieht makro 1 und 2 aus:
[code]
Sub Start_Rohdaten_ImportTXT()
Worksheets("Rohdaten").Activate
Dim myPath As String
Dim myOutputFile As String
myPath = Range("MarcoValues!B2").Value
myOutputFile = Range("MarcoValues!B3").Value
'myPath = "C:\Analyzer_Tool\" 'wichtig: am Schluss muss ein \ _
stehen
'myOutputFile = "output.txt"
MergeFiles myPath, myOutputFile
Import_TXT myPath & myOutputFile, "$b$1", "b:g"
End Sub
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
numOut = FreeFile
Open SourceFolder & OutputFile For Output As #numOut
Dateiname = Dir(SourceFolder & "*.txt")
Do While Not Dateiname = ""
If Dateiname OutputFile Then
numIN = FreeFile
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.
Print #numOut, Textzeile 'Ausgabe im Datei.
Loop
Close #numIN
End If
Dateiname = Dir
Loop
Close #numOut
End Sub
Sub Import_TXT(Filename As String, Position As String, DataRange As String)
Range(DataRange).Select
Selection.ClearContents
MsgBox "DataRange: " & DataRange & " 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
Application.Dialogs(xlDialogSaveAs).Show
End Sub
[/code]
vielen dank für eure hilfe, habe gar keinen plan wie sowas zu programmieren ist.
gruss christian