Textdatei aus Excel für Datenimport

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Textdatei aus Excel für Datenimport | Herbers Excel-Forum

Textdatei aus Excel für Datenimport von Ronald vom 28.01.2010 17:08:55

kannst mal diesen Code testen. - von Tino am 28.01.2010 18:00:11
Korrektur ... - von Tino am 28.01.2010 18:37:18
- AW: Korrektur ... - von Ronald am 29.01.2010 09:52:43
  - ok. nochmal, - von Tino am 29.01.2010 11:37:27
    - AW: ok. nochmal, - von Ronald am 29.01.2010 12:10:41
      - ok. habe nochmal komplett neu angefangen. - von Tino am 29.01.2010 13:08:19
        
        AW: ok. habe nochmal komplett neu angefangen. - von Ronald am 29.01.2010 14:44:57
warum neuer Beitrag? - von Tino am 28.01.2010 18:48:52

Betrifft: Textdatei aus Excel für Datenimport von: Ronald
Geschrieben am: 28.01.2010 17:08:55

Hallo,

ich brauche eine Textdatei die ich in einem anderen Programm einlesen will. In der Textdatei muss unbedingt die Schnittstellenbeschreibung eingehalten werden.

A1 = 01
B1 = 0000005401
C1 = AOK Krankenkasse M-V
D1 = Meier

In der Textdatei muss dann am Ende die Sache so aussehen:

010000005401AOK Krankenkasse ___________________________________________M-V Meier

die _ Zeichen sollen Leerzeichen sein.

dann der nächste Datensatz.

in C1 der Text ist immer kürzer als 60 Zeichen, muss dann auf 60 Zeichen mit Leerezeichen aufgefüllt werden.

Wie bekommt man sowas hin?

Gruß Ronald

Betrifft: kannst mal diesen Code testen. von: Tino
Geschrieben am: 28.01.2010 18:00:11

Hallo,

die Textdatei wird im gleichen Ordner wo sich auch die Excel- Datei befindet abgelegt.
Ist diese vorhanden wird sie zuvor gelöscht.

Tabellennamen noch anpassen.

Sub schreibeTXTDatei()Dim F As IntegerDim sFilePath$, FileName$, strAusgabe$Dim strSpalte3 As String * 60Dim meArDim A&, AA&'Dateiname der Textdatei (Ausgabe) FileName = "TextDatei.txt"'Tabelle anpassen meAr = Sheets("Tabelle1").UsedRange.Columns("A:D").Value'wird im Ordner der Exceldatei gespeichert sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")FileName = sFilePath & FileName'alte Datei löschen fals vorhanden. If Dir(FileName) <> "" Then Kill FileName    F = FreeFile  Open FileName For Append As #F    For A = 1 To Ubound(meAr)    For AA = 1 To Ubound(meAr, 2)        If AA = 3 Then         strSpalte3 = meAr(A, AA)         strAusgabe = strAusgabe & strSpalte3        ElseIf AA > 3 Then         strAusgabe = strAusgabe & " " & meAr(A, AA)        Else         strAusgabe = strAusgabe & meAr(A, AA)        End If    Next AA        Print #F, strAusgabe    strAusgabe = ""  Next A    Close #FEnd Sub

Gruß Tino

Betrifft: Korrektur ... von: Tino
Geschrieben am: 28.01.2010 18:37:18

Hallo,
habe jetzt erst gesehen das die Leerzeichen wo anders stehen sollen.

Sub schreibeTXTDatei()Dim F As IntegerDim sFilePath$, FileName$, strAusgabe$Dim tmpStr$Dim meArDim A&, AA&'Dateiname der Textdatei (Ausgabe) FileName = "TextDatei.txt"'Tabelle anpassen meAr = Sheets("Tabelle1").UsedRange.Columns("A:D").Value'wird im Ordner der Exceldatei gespeichert sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")FileName = sFilePath & FileName'alte Datei löschen fals vorhanden. If Dir(FileName) <> "" Then Kill FileName    F = FreeFile  Open FileName For Append As #F    For A = 1 To Ubound(meAr)    For AA = 1 To Ubound(meAr, 2)        If AA = 3 Then         tmpStr = Left$(meAr(A, AA), InStrRev(meAr(A, AA), " ") - 1)         tmpStr = tmpStr & String(61 - Len(meAr(A, AA)), " ") & _                  Right$(meAr(A, AA), Len(meAr(A, AA)) - InStrRev(meAr(A, AA), " "))         strAusgabe = strAusgabe & tmpStr        ElseIf AA > 3 Then         strAusgabe = strAusgabe & " " & meAr(A, AA)        Else         strAusgabe = strAusgabe & meAr(A, AA)        End If    Next AA        Print #F, strAusgabe    strAusgabe = ""  Next A    Close #FEnd Sub

Gruß Tino

Betrifft: AW: Korrektur ... von: Ronald
Geschrieben am: 29.01.2010 09:52:43

Hallo Tino,

vielen Dank erstmal. Leider bekomme ich eine Fehlermeldung. Ich hänge die Datei mal dran.

https://www.herber.de/bbs/user/67609.xls

Gruß Ronald

Betrifft: ok. nochmal, von: Tino
Geschrieben am: 29.01.2010 11:37:27

Hallo,
irgendwie kommt es mir vor dass die Datei anders aussieht wie im ersten Beitrag beschrieben.

Sub schreibeTXTDatei()Dim F As IntegerDim sFilePath$, FileName$, strAusgabe$Dim tmpStr$, strText$Dim rngBereich As Range, rngRows As RangeDim A&, AA&'Dateiname der Textdatei (Ausgabe) FileName = "TextDatei.txt"'Tabelle anpassen Set rngBereich = Sheets("Tabelle1").UsedRange.Columns("A:D")'wird im Ordner der Exceldatei gespeichert sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")FileName = sFilePath & FileName'alte Datei löschen fals vorhanden. If Dir(FileName) <> "" Then Kill FileNameWith Application.WorksheetFunction  F = FreeFile  Open FileName For Append As #F    For Each rngBereich In rngBereich.Rows    For Each rngRows In rngBereich.Cells               If rngRows.Column = 3 Then         If InStr(rngRows.Text, " ") > 0 Then            strText = Trim$(.Clean(rngRows.Text))            tmpStr = Left$(strText, InStrRev(strText, " ") - 1)            tmpStr = tmpStr & String(61 - Len(strText), " ") & _                     Right$(strText, Len(strText) - InStrRev(strText, " "))            strAusgabe = strAusgabe & tmpStr         Else            strAusgabe = strAusgabe & String(60, " ")         End If        ElseIf rngRows.Column > 3 Then         strAusgabe = strAusgabe & " " & .Clean(rngRows.Text)        Else         strAusgabe = strAusgabe & .Clean(rngRows.Text)        End If    Next rngRows        Print #F, strAusgabe    strAusgabe = ""  Next rngBereich    Close #FEnd WithEnd Sub

Gruß Tino

Betrifft: AW: ok. nochmal, von: Ronald
Geschrieben am: 29.01.2010 12:10:41

Hallo Tino,

ja, das sieht fantastisch aus und die Datei war bestimmt vorher anders, hab schon soviel probiert. Die paar Spalten sind ja auch nur ein Auszug der ganzen Daten. Es komplett noch viel mehr Spalten. Ich bin schon seit heute morgen dabei die Daten in einer Exceldatei mit Formeln zusammenzutragen.

Kann man Dein Makro dann noch anpassen? Ich habe am Ende Spalten von A bis BD, wobei ich in jeder Excel Zelle jetzt die genaue Zeichenanzahl habe. In Spalte A steht jetzt z.B. 01 in der Textdatei schreibt er jetzt 1. Ich weiß nicht ob das sehr aufwendig ist.

Vielen Dank für Deine Hilfe.

Gruß Ronald

Betrifft: ok. habe nochmal komplett neu angefangen. von: Tino
Geschrieben am: 29.01.2010 13:08:19

Hallo,
hier das Beispiel als zip.
Die Exceldatei sollte wie im Beispiel aufgebaut sein.

https://www.herber.de/bbs/user/67622.zip

In der Excel auf den Button drücken.

Mehr kann ich nicht machen.

Gruß Tino

Betrifft: AW: ok. habe nochmal komplett neu angefangen. von: Ronald
Geschrieben am: 29.01.2010 14:44:57

Vielen Dank Tino,

löst mein Problem zwar nicht vollständig, aber danke für Deine Mühe.

Ich hab die Exceldatei jetzt fertig und versuche mein Glück hier im Forum nochmal.

Gruß Ronald

Betrifft: warum neuer Beitrag? von: Tino
Geschrieben am: 28.01.2010 18:48:52

Hallo,

https://www.herber.de/forum/archiv/1132to1136/t1133804.htm

Hättest auch dort bleiben können, warum neuer Beitrag?

Gruß Tino