PDA

Vollständige Version anzeigen : .dta export


joelja
05.08.2014, 17:54
Hallo ihr Lieben :) ,

ich habe schon überall gesucht und nichts gefunden was speziell zu meinem Problem passt bzw. ich habe schon vieles gefunden aber ich habe es nicht geschafft auf meinen Spezialfall anzupassen.

Ich hoffe ihr könnt mir bei meinem Problem weiterhelfen :)

ich habe in der Spalte C Daten die müsste ich in eine .dta exportieren.

Die Makro soll mir aber mehrere .dta's erstellen.

In der Spalte G steht das Wort Start und in der Spalte H das Wort Stop, die Makro soll sich hier orientieren und soll mir 3 Zeilen in der Spalte C über dem Start bis zu dem Wort Stop + zwei Zeilen drunter die Werte aus C in eine .dta schreiben.

Die Makro soll mir dann noch einen Ordner mit Tagesdatum erstellen und die .dta soll wie folgt benannt werden:

Orientierungspunkt ist wieder das Wort Start in Spalte G - Dateiname setzt sich aus Wert in Spalte B das vorher Minus 35000000 genommen werden muss und unterstrich aus Wert in Spalte A der vorher ebenfalls Minus 1200000 genommen werden muss, zusammen.

Bsp. Datei 1 = 160714_1234.dta
Datei 2 = 170714_1234.dta
Datei 3 = 180714_1235.dta

Im Anhang findet ihr eine Test-Datei, in der Datei ist alles wichtige farblich markiert.

Ich würde mich sehr über euere Hilfe freuen, ich sage schonmal vielen lieben Dank :).

joelja
08.08.2014, 15:30
Hallo ihr lieben,

ich bin echt ratlos, kann mir denn hier auch keiner weiterhelfen :( ?

Ich würde mich über jede Antwort freuen, auch wenn mir jemand sagt, dass es so nicht funktioniert und man auf eine alternative Lösung ausweichen muss.

Lg

eure joelja

GMG-CC
08.08.2014, 16:18
ich bin echt ratlos, kann mir denn hier auch keiner weiterhelfen :( ?
Die Ratlosigkeit dürfte auch bei vielen der Helfer präsent sein. Steht "dta" für "Deutsch-Türkisch-Arabisch" oder welches Format soll bzw. sollen die Ausgabedateien haben?

... Und überhaupt, die Erklärungen sind insgesamt etwas unpräzise.

EarlFred
08.08.2014, 16:34
Hallo joelja,

ratlos :(
wir auch.

Wenn keine Reaktion kommt, liegt es meist an ungeklärten Fragen ODER dem erahnten Wunsch, eine Komplettlösung haben zu wollen.

Auch wenn Du Dir sichtlich Mühe bei der Beschreibung gegeben hast: Günther hat schon recht mit der Rüge, dass Du zum (entscheidenden) Aufbau des Dateityps "dta" nichts gesagt hast. Zu den (mir bekannten) Spezifikationen des Datenträgeraustauschverfahrens scheinen sie nicht zu passen (habe es aber auch nicht im Detail geprüft), daher gehe ich von einer reinen Text-Datei aus.

Weil Du Dir wirklich Mühe gegeben hast, gibt's nachfolgend eine Komplettlösung für meine Annahmen. Anpassungen, wenn ich falsch liege, nimmst Du aber bitte selbst vor - etwas Eigenleistung muss schon sein! Und wenn Du Fragen hast, frage bitte gezielt nach.

Option Explicit

Sub ErstelleDTAs()
Dim i As Long
Dim rngStartzeilen As Range, rngStopzeilen As Range
Dim strSchreibeInDatei As String
Dim strDatnam As String
Dim strPfad As String

Set rngStartzeilen = Columns("G").SpecialCells(xlCellTypeConstants)
Set rngStopzeilen = Columns("H").SpecialCells(xlCellTypeConstants)

strPfad = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & "\"
If chkDir(strPfad) Then

For i = 2 To Application.Min(rngStartzeilen.Areas.Count, rngStopzeilen.Areas.Count)
With rngStartzeilen.Areas(i).Cells(1)
strDatnam = CStr(.Offset(, -5).Value - 35000000) & "_" & CStr(.Offset(, -6).Value - 1200000) & ".dta"
strSchreibeInDatei = Join(Application.Transpose(Range(.Offset(-3, -4), rngStopzeilen.Areas(i).Cells(1).Offset(2, -5))), vbCrLf)
TextInDateiSchreiben strPfad & strDatnam, strSchreibeInDatei
End With
Next i

End If

Set rngStopzeilen = Nothing
Set rngStartzeilen = Nothing

End Sub


Private Function TextInDateiSchreiben(ByRef strDatnam As String, ByRef strText As String) As Boolean
'-------------------------------------------------------------------------------------------------
'Function schreibt einen Text in eine (Text-)Datei
'und gibt den Erfolg as Wahrheitswert zurück
'http://vb-tec.de/speicher.htm
'-------------------------------------------------------------------------------------------------
Dim lngFileNr As Long

'Wenn Datei unverändert, dann abbrechen (ggf. weglassen):
If Dir$(strDatnam) > "" Then _
If FileLen(strDatnam) = Len(strText) Then _
If TextAusDateiLesen(strDatnam) = strText Then Exit Function

'Text speichern:
lngFileNr = FreeFile
Open strDatnam For Output As #lngFileNr
Print #lngFileNr, strText;
Close #lngFileNr

TextInDateiSchreiben = (Err = 0)
End Function
Public Function TextAusDateiLesen(ByVal strDatnam As String) As String
'-------------------------------------------------------------------------------------------------
'Function liest eine (Text-)Datei ein
'und gibt den Inhalt als Funktionswert zurück
'http://vb-tec.de/readfile.htm
'-------------------------------------------------------------------------------------------------
Dim lngFileNr As Long

On Error Resume Next
If FileLen(strDatnam) = 0 Then Exit Function
On Error GoTo 0

lngFileNr = FreeFile
Open strDatnam For Binary As #lngFileNr
TextAusDateiLesen = Space$(LOF(lngFileNr))
Get #lngFileNr, , TextAusDateiLesen
Close #lngFileNr

End Function

Private Function chkDir(ByVal strPfad As String) As Boolean
Dim fVerz As Variant, i As Long, strPfadTemp As String

If Right(strPfad, 1) = "\" Then strPfad = Left(strPfad, Len(strPfad) - 1)
fVerz = Split(strPfad, "\")
On Error GoTo errExit

For i = LBound(fVerz) To UBound(fVerz)
strPfadTemp = strPfadTemp & fVerz(i) & "\"
If Len(Dir(strPfadTemp, vbDirectory)) = 0 Then MkDir strPfadTemp
Next i

errExit:
chkDir = Err = 0
End Function

Grüße
EarlFred

joelja
08.08.2014, 21:41
Tut mir leid das ich mich undeutlich ausgedrückt hatte. Natürlich ist das Format der txt gemeint.

Ich bedanke mich für euere Antworten, ihr macht mich gerade echt happy.. Ich stand Tage lang am schlauch.. Ich werde deinen Lösungsvorschlag gleich morgen ausprobieren und anschließend berichten..

Ein schönes Wochenende wünsche ich euch :)

Lg

Joelja