Benötige Unterstützung in VBA (.txt-Import in .unv-Import umwandeln)
Habe leider das Problem immer noch nicht gelöst bekommen. Ich versuche schon seit Tagen mein vorhandenes Makro welches Daten aus *.txt-Dokumenten auslesen kann, so umzuschreiben, dass es *.unv-Dokumente auslesen kann. Leider scheint dieses Dateiformat nicht so verbreitet zu sein, intensive Foren- und Websuche brachte leider kein Ergebnis.
Hier der Ausgangscode (mit besten Dank an bastla ;)
Excel sollte das eigentlich können, denn über manuelles Datenimportieren, wird folgender Code benutzt:
Da ich so gut wie keine VBA Kenntnisse habe ist es mir nicht gelungen den Zweiten Code so in den ersten einzufügen, dass dieser auch *.unv verarbeiten kann. Es müsste doch eigentlich nur Zeile 12 (in Code1) angepasst werden oder irre ich mich?
Hat jemand von euch vieleicht eine Idee?
Gruß Brauseklaus
Hier der Ausgangscode (mit besten Dank an bastla ;)
Sub WEAR()
Datei = "C:\Dukument.txt"
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern
SpNr = 1 'Daten ab Spalte A ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen
Fertig = False 'Schalter initialisieren
IMport = False 'Schalter initialisieren
Do While Not DateiEin.AtEndOfStream And Not Fertig
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Satz = Replace(Satz, ".", ",")
If IMport Then 'Satz ist zu importieren
If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Else
Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen
End If
Else 'bisher wurde nicht importiert - ...
If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich?
IMport = True 'ja; ab jetzt Zeilen importieren
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
End If
End If
Loop
DateiEin.Close 'Textdatei schließen
MsgBox "Fertig."
End Sub
Sub SatzEintragen(D, Z, S)
Do While InStr(D, " ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ...
D = Replace(D, " ", " ") ' ... diese durch ein einzelnes ersetzen
Loop
Felder = Split(D) 'Zeile in Felder zerlegen
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen
End Sub
Excel sollte das eigentlich können, denn über manuelles Datenimportieren, wird folgender Code benutzt:
Sub Makro3()
'
' Makro3 Makro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Dokument.unv" _
, Destination:=Range("$A$1"))
.Name = "inc0_1"
.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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Da ich so gut wie keine VBA Kenntnisse habe ist es mir nicht gelungen den Zweiten Code so in den ersten einzufügen, dass dieser auch *.unv verarbeiten kann. Es müsste doch eigentlich nur Zeile 12 (in Code1) angepasst werden oder irre ich mich?
Hat jemand von euch vieleicht eine Idee?
Gruß Brauseklaus
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 144507
Url: https://administrator.de/forum/benoetige-unterstuetzung-in-vba-txt-import-in-unv-import-umwandeln-144507.html
Ausgedruckt am: 22.05.2025 um 18:05 Uhr
16 Kommentare
Neuester Kommentar
Hallo Brauseklaus!
Da ich keine Testdatei zur Verfügung habe, bleibt eigentlich nur schrittweises Herantasten ...
Ich habe den Code von oben so reduziert, dass jede Zeile gelesen und eingetragen werden sollte:
Wenn das nicht funktioniert (BTW: wie sieht denn bisher das Ergebnis aus?), solltest Du prüfen, ob überhaupt eine Unicode-Datei vorliegt (dazu Zeile 12 auf
ändern und dadurch die Textdatei wieder als ANSI interpretieren).
Noch einfacher (der gesamte Satz wird ohne Aufspaltung in einzelne Felder komplett in Spalte A eingetragen, Punkte werden nicht umgewandelt) sähe das so aus:
Grüße
bastla
Da ich keine Testdatei zur Verfügung habe, bleibt eigentlich nur schrittweises Herantasten ...
Ich habe den Code von oben so reduziert, dass jede Zeile gelesen und eingetragen werden sollte:
Sub WEAR()
Datei = "C:\Dokument.unv"
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern
SpNr = 1 'Daten ab Spalte A ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen
Do While Not DateiEin.AtEndOfStream
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Satz = Replace(Satz, ".", ",") 'Punkt durch Komma ersetzen
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Loop
DateiEin.Close 'Textdatei schließen
MsgBox "Fertig."
End Sub
Sub SatzEintragen(D, Z, S)
Do While InStr(D, " ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ...
D = Replace(D, " ", " ") ' ... diese durch ein einzelnes ersetzen
Loop
Felder = Split(D) 'Zeile in Felder zerlegen
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen
End Sub
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0)
Noch einfacher (der gesamte Satz wird ohne Aufspaltung in einzelne Felder komplett in Spalte A eingetragen, Punkte werden nicht umgewandelt) sähe das so aus:
Sub WEAR()
Datei = "C:\Dokument.unv"
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern
SpNr = 1 'Daten ab Spalte A ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen
Do While Not DateiEin.AtEndOfStream
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Cells(ZNr, SpNr) = Satz 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Loop
DateiEin.Close 'Textdatei schließen
MsgBox "Fertig."
End Sub
bastla
Hallo Brauseklaus!
Wenn sich die ".unv"-Dateien in "normalen" Text konvertieren lassen, könnte auch folgendes (einzugeben in der CMD-Shell) funktionieren:
Falls sich die so erstellte Textdatei einlesen lässt, können Deine hunderten Dateien mit einer einfachen Schleife umgewandelt werden ...
Testdatei ist natürlich auch keine schlechte Idee - meine Mail-Adresse folgt per PN.
Grüße
bastla
Wenn sich die ".unv"-Dateien in "normalen" Text konvertieren lassen, könnte auch folgendes (einzugeben in der CMD-Shell) funktionieren:
type C:\Dokument.unv>C:\Dokument.txt
Testdatei ist natürlich auch keine schlechte Idee - meine Mail-Adresse folgt per PN.
Grüße
bastla
Hallo Brauseklaus!
Da in Excel 2007 alleine schon über 1 Million Zeilen je Tabellenblatt möglich sind, würde ich bei den von Dir genannten Datenmengen nicht unbedingt an ein Kapazitätsproblem denken - getestet habe ich das aber auch noch nie, und einen sachdienlichen Hinweis kann ich leider auch nicht anbieten ...
Grüße
bastla
Da in Excel 2007 alleine schon über 1 Million Zeilen je Tabellenblatt möglich sind, würde ich bei den von Dir genannten Datenmengen nicht unbedingt an ein Kapazitätsproblem denken - getestet habe ich das aber auch noch nie, und einen sachdienlichen Hinweis kann ich leider auch nicht anbieten ...
Jedes Tabellenblatt habe ich mit einem Makro versehen
Das sollte eigentlich nicht nötig sein - im Makro gibt es keinen Bezug zu einer speziellen Tabelle, sodass eigentlich immer in die beim Start des Makros geöffnete Tabelle geschrieben werden sollte.Grüße
bastla
Hallo Brauseklaus!
Du könntest es so versuchen:
Die Schleife durchläuft die Tabellenblätter ab dem zweiten Blatt (der Blattname ist jeweils egal).
Da sich in den 3 Bereichen eigentlich nur "Von", "Bis" und die "SpNr" unterscheiden, gibt es da noch weiteres Optimierungpotenzial (können wir in Angriff nehmen, sobald es mit dieser Version geklappt hat) ...
Grüße
bastla
Du könntest es so versuchen:
Sub Alle()
Datei = "C:\Users\Brause\Documents\Dokumente Works\Nico FH\IPH\Excel\zwei_symetrien\inc"
Typ = ".unv"
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern
For i = 2 To Worksheets.Count
Worksheets(i).Activate
Von = "NORMALSTRESS" 'ab Zeile mit diesem Inhalt importieren
Bis = "FLOWSTRESS" 'ab Zeile mit diesem Inhalt nicht mehr importieren
SpNr = 1 'Daten ab Spalte A ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen
Fertig = False 'Schalter initialisieren
Import = False 'Schalter initialisieren
Do While Not DateiEin.AtEndOfStream And Not Fertig
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Satz = Replace(Satz, ".", ",")
If Import Then 'Satz ist zu importieren
If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Else
Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen
End If
Else 'bisher wurde nicht importiert - ...
If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich?
Import = True 'ja; ab jetzt Zeilen importieren
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
End If
End If
Loop
Von = "TEMPERATURE" 'ab Zeile mit diesem Inhalt importieren
Bis = "32700" 'ab Zeile mit diesem Inhalt nicht mehr importieren
SpNr = 8 'Daten ab Spalte H ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen
Fertig = False 'Schalter initialisieren
Import = False 'Schalter initialisieren
Do While Not DateiEin.AtEndOfStream And Not Fertig
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Satz = Replace(Satz, ".", ",")
If Import Then 'Satz ist zu importieren
If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Else
Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen
End If
Else 'bisher wurde nicht importiert - ...
If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich?
Import = True 'ja; ab jetzt Zeilen importieren
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
End If
End If
Loop
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren
SpNr = 12 'Daten ab Spalte L ...
ZNr = 3 'der Zeile 3 eintragen
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen
Fertig = False 'Schalter initialisieren
Import = False 'Schalter initialisieren
Do While Not DateiEin.AtEndOfStream And Not Fertig
Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen
Satz = Replace(Satz, ".", ",")
If Import Then 'Satz ist zu importieren
If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
Else
Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen
End If
Else 'bisher wurde nicht importiert - ...
If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich?
Import = True 'ja; ab jetzt Zeilen importieren
SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen
ZNr = ZNr + 1 'nächste Tabellenzeile
End If
End If
Loop
DateiEin.Close 'Textdatei schließen
Next
End Sub
Sub SatzEintragen(D, Z, S)
Do While InStr(D, " ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ...
D = Replace(D, " ", " ") ' ... diese durch ein einzelnes ersetzen
Loop
Felder = Split(D) 'Zeile in Felder zerlegen
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen
End Sub
Da sich in den 3 Bereichen eigentlich nur "Von", "Bis" und die "SpNr" unterscheiden, gibt es da noch weiteres Optimierungpotenzial (können wir in Angriff nehmen, sobald es mit dieser Version geklappt hat) ...
Grüße
bastla
Hallo Brauseklaus!
Nur zur Sicherheit solltest Du einmal vorweg nach den "
Zum Testen könntest Du einfach vor die Zeile 18 (und ev auch 47 und 76) den Befehl
setzen und Dir damit im "Direktbereich" (Aufruf mit Strg+G) des VBA-Editors jeweils die zu öffnende Datei anzeigen lassen - so sollte sich feststellen lassen, welche Datei denn nun nicht gefunden wird.
Als Alternative könnte natürlich auch mit
(ebenfalls unmittelbar vor der Zeile 18) geprüft werden, ob die Datei vorhanden ist - allerdings müsste dann natürlich eine Fehlerbehandlung (und sei es ein Abbruch mit dem Hinweis auf die fehlende Datei) integriert werden.
Grüße
bastla
Nur zur Sicherheit solltest Du einmal vorweg nach den "
Loop
"-Zeilen 38 und 67 jeweils die Datei schließen:DateiEin.Close 'Textdatei schließen
Ich nehme an, dass das Programm nach weiteren .unv-Datein vergeblich weiter sucht.
Es wird versucht, für jedes Tabellenblatt (außer dem ersten) eine Datei zu öffnen - demnach ist die Anzahl der Dateien vorgegeben ...Zum Testen könntest Du einfach vor die Zeile 18 (und ev auch 47 und 76) den Befehl
Debug.Print Datei & CStr(i-2) & Typ
Als Alternative könnte natürlich auch mit
If fso.FileExists(Datei & CStr(i-2) & Typ) Then
Grüße
bastla
Hallo Brauseklaus!
Der Dateiname wird mit "
Grüße
bastla
Der Dateiname wird mit "
Datei & CStr(i-2) & Typ
" festgelegt - wenn Du daher anstelle von "-2" den Wert "-3" verwendest, könnte die Nummerierung passen.Ein weiterer Punkt ist, da ich das Dokument vielfach duplizieren möchte und es vorkommen kann, dass auch mal 71-unv’s auszulesen sind, ob man dieses berücksichtigen könnte.
Wie erwähnt wird das Einlesen durch die Anzahl der Tabellenblätter gesteuert (siehe "For i = 2 To Worksheets.Count
") ...Grüße
bastla
Hallo Brauseklaus!
Mit "
Als (langsamere) Alternative könntest Du es mit folgendem "Sub" versuchen:
Grüße
bastla
Mit "
.Value
" hat das nix zu tun (damit wird nur angegeben, dass als "Wert" und nicht als "Formel" eingetragen wird und könnte, da Default, sogar weggelassen werden) - das kommt eher daher, dass der Satz als String gelesen und dann in Teilstrings gesplittet wird ...Als (langsamere) Alternative könntest Du es mit folgendem "Sub" versuchen:
Sub SatzEintragen(D, Z, S)
Do While InStr(D, " ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ...
D = Replace(D, " ", " ") ' ... diese durch ein einzelnes ersetzen
Loop
Felder = Split(D) 'Zeile in Felder zerlegen
For j = 0 To UBound(Felder)
Cells(Z, S + j).Value = Felder(j) 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen
Next
End Sub
bastla