Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Benötige Unterstützung in VBA (.txt-Import in .unv-Import umwandeln)

Frage Microsoft Microsoft Office

Mitglied: Brauseklaus

Brauseklaus (Level 1) - Jetzt verbinden

09.06.2010 um 22:07 Uhr, 5978 Aufrufe, 16 Kommentare

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 ;)

01.
Sub WEAR() 
02.
Datei = "C:\Dukument.txt" 
03.
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren 
04.
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
05.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
06.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
07.
 
08.
SpNr = 1 'Daten ab Spalte A ... 
09.
ZNr = 3 'der Zeile 3 eintragen 
10.
 
11.
 
12.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen 
13.
Fertig = False 'Schalter initialisieren 
14.
IMport = False 'Schalter initialisieren 
15.
Do While Not DateiEin.AtEndOfStream And Not Fertig 
16.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
17.
    Satz = Replace(Satz, ".", ",") 
18.
    If IMport Then 'Satz ist zu importieren 
19.
        If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
20.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
21.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
22.
        Else 
23.
            Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
24.
        End If 
25.
    Else 'bisher wurde nicht importiert - ... 
26.
        If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
27.
            IMport = True 'ja; ab jetzt Zeilen importieren 
28.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
29.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
30.
        End If 
31.
    End If 
32.
Loop 
33.
DateiEin.Close 'Textdatei schließen 
34.
MsgBox "Fertig." 
35.
End Sub 
36.
 
37.
Sub SatzEintragen(D, Z, S) 
38.
Do While InStr(D, "  ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ... 
39.
    D = Replace(D, "  ", " ") ' ... diese durch ein einzelnes ersetzen 
40.
Loop 
41.
Felder = Split(D) 'Zeile in Felder zerlegen 
42.
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen 
43.
End Sub 
44.
 
Excel sollte das eigentlich können, denn über manuelles Datenimportieren, wird folgender Code benutzt:

01.
Sub Makro3() 
02.
03.
' Makro3 Makro 
04.
05.
 
06.
07.
    With ActiveSheet.QueryTables.Add(Connection:= _ 
08.
        "TEXT;C:\Dokument.unv" _ 
09.
        , Destination:=Range("$A$1")) 
10.
        .Name = "inc0_1" 
11.
        .FieldNames = True 
12.
        .RowNumbers = False 
13.
        .FillAdjacentFormulas = False 
14.
        .PreserveFormatting = True 
15.
        .RefreshOnFileOpen = False 
16.
        .RefreshStyle = xlInsertDeleteCells 
17.
        .SavePassword = False 
18.
        .SaveData = True 
19.
        .AdjustColumnWidth = True 
20.
        .RefreshPeriod = 0 
21.
        .TextFilePromptOnRefresh = False 
22.
        .TextFilePlatform = 850 
23.
        .TextFileStartRow = 1 
24.
        .TextFileParseType = xlDelimited 
25.
        .TextFileTextQualifier = xlTextQualifierDoubleQuote 
26.
        .TextFileConsecutiveDelimiter = True 
27.
        .TextFileTabDelimiter = True 
28.
        .TextFileSemicolonDelimiter = False 
29.
        .TextFileCommaDelimiter = False 
30.
        .TextFileSpaceDelimiter = True 
31.
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) 
32.
        .TextFileDecimalSeparator = "." 
33.
        .TextFileTrailingMinusNumbers = True 
34.
        .Refresh BackgroundQuery:=False 
35.
    End With 
36.
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
Mitglied: bastla
09.06.2010 um 23:37 Uhr
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:
01.
Sub WEAR() 
02.
Datei = "C:\Dokument.unv" 
03.
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren 
04.
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
05.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
06.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
07.
 
08.
SpNr = 1 'Daten ab Spalte A ... 
09.
ZNr = 3 'der Zeile 3 eintragen 
10.
 
11.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen 
12.
Do While Not DateiEin.AtEndOfStream 
13.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
14.
    Satz = Replace(Satz, ".", ",") 'Punkt durch Komma ersetzen 
15.
    SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
16.
     ZNr = ZNr + 1 'nächste Tabellenzeile 
17.
Loop 
18.
DateiEin.Close 'Textdatei schließen 
19.
MsgBox "Fertig." 
20.
End Sub 
21.
 
22.
Sub SatzEintragen(D, Z, S) 
23.
Do While InStr(D, "  ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ... 
24.
    D = Replace(D, "  ", " ") ' ... diese durch ein einzelnes ersetzen 
25.
Loop 
26.
Felder = Split(D) 'Zeile in Felder zerlegen 
27.
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen 
28.
End Sub
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
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0)
ä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:
01.
Sub WEAR() 
02.
Datei = "C:\Dokument.unv" 
03.
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren 
04.
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
05.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
06.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
07.
 
08.
SpNr = 1 'Daten ab Spalte A ... 
09.
ZNr = 3 'der Zeile 3 eintragen 
10.
 
11.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0, -1) 'Textdatei im Unicode-Format öffnen 
12.
Do While Not DateiEin.AtEndOfStream 
13.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
14.
    Cells(ZNr, SpNr) = Satz 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
15.
     ZNr = ZNr + 1 'nächste Tabellenzeile 
16.
Loop 
17.
DateiEin.Close 'Textdatei schließen 
18.
MsgBox "Fertig." 
19.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: Brauseklaus
10.06.2010 um 00:14 Uhr
Hi bastla,
habe alle 3 Varianten getestet, leider immer das Gleiche: er rechnet und rechnet und rechnet bis ich ihn über Taskmanager kille. Die *.txt werden wunderbar genommen und die Aktion ist in wenigen Sekunden durch.
Wie gesagt, leider gibt das FEM-Programm mit dem ich arbeite nur *.unv's aus. Und alle manuell in *.txt zu konvertieren wäre Wahnsinn. Ich muss leider hunderte Auswerten ;(

Wenn es die Sache erleichtert, kann ich dir gerne eine Testdatei zukommen lassen (Größe ca.80kb).

Gruß Brauseklaus
Bitte warten ..
Mitglied: bastla
10.06.2010 um 00:21 Uhr
Hallo Brauseklaus!

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
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
Bitte warten ..
Mitglied: Brauseklaus
10.06.2010 um 18:40 Uhr
Hi bastla,

du hattest völlig recht, unv-Dokumente sollte man nicht als unicode öffnen oindern als ANSI.
Die Dateien lassen sich jetzt direkt einlesen.

Nur hab ich nun ein neues Problem, ab einer bestimmten Anzahl von Tabellenblättern (ich habe 71) mit dem entsprechenden (oft 30000 Zeilen) Inhalt, funktionieren die Markros generell nicht mehr . Einzig das 1. Makro, welches ich in einem Modul geschrieben habe, verrichtet nach wie vor seinen Dienst.
Jedes Tabellenblatt habe ich mit einem Makro versehen, welches 3 Parameter mit jeweils ca. 30000 Zeilen einlesen soll. Kann es sein das Excel da an seine Grenzen stößt? (sowohl Excel2003 als auch -2007).

Ich meine irgendwo gelesen zu habe, dass Excel 2007 mit 1GB Daten umgehen kann...

An meinem Rechner kann es auch nicht liegen 4x3,4Ghz; 8GB RAM, WIN7 x64

Gruß Brausklaus
Bitte warten ..
Mitglied: bastla
10.06.2010 um 19:48 Uhr
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 ...
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
Bitte warten ..
Mitglied: Brauseklaus
11.06.2010 um 00:45 Uhr
Hi,

Also, jede einzelne Umformsimulation wird vom FEM-Programm in ca. 72 Schritten abgearbeitet. Jeder einzelne Schritt kann als *.unv mit diversen Prozessgrößen ausgeben werden. Also sind insgesamt 72 unv's pro Simulation auszuwerten.

Mein Excel-Ziel-Dokument hat insgesamt 73 Sheets, das 1. ist das Ziel an dem alles aus dem Dokument letztendlich für Berechnungen zusammenläuft (das funktioniert). Die restlichen 72 Sheets importieren Werte aus den unv's. Jedes Sheet Importiert 3 Werte (immer NORMALSTRESS, TEMPERATURE und WEAR) von einer unv und stellt diese nebeneinander da. Alles unv's sind gleich aufgebaut.

Dazu habe ich den Quellcode 72mal vervielfältigt, auf jede zu importierende unv angepasst (diese heißen inc0.unv; inc1.unv; inc2.unv;......inc72.unv) und einzeln in die 72 Tabellenblätter im Editor kopiert.

Hier ein Bsp:

01.
Sub inc0() 
02.
Datei = "C:\Users\Brause\Documents\Dokumente Works\Nico FH\IPH\Excel\zwei_symetrien\inc0.unv" 
03.
Von = "NORMALSTRESS" 'ab Zeile mit diesem Inhalt importieren 
04.
Bis = "FLOWSTRESS" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
05.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
06.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
07.
 
08.
SpNr = 1 'Daten ab Spalte A ... 
09.
ZNr = 3 'der Zeile 3 eintragen 
10.
 
11.
 
12.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0) 'Textdatei im öffnen 
13.
Fertig = False 'Schalter initialisieren 
14.
Import = False 'Schalter initialisieren 
15.
Do While Not DateiEin.AtEndOfStream And Not Fertig 
16.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
17.
    Satz = Replace(Satz, ".", ",") 
18.
    If Import Then 'Satz ist zu importieren 
19.
        If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
20.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
21.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
22.
        Else 
23.
            Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
24.
        End If 
25.
    Else 'bisher wurde nicht importiert - ... 
26.
        If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
27.
            Import = True 'ja; ab jetzt Zeilen importieren 
28.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
29.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
30.
        End If 
31.
    End If 
32.
Loop 
33.
 
34.
Von = "TEMPERATURE" 'ab Zeile mit diesem Inhalt importieren 
35.
Bis = "32700" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
36.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
37.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
38.
 
39.
SpNr = 8 'Daten ab Spalte H ... 
40.
ZNr = 3 'der Zeile 3 eintragen 
41.
 
42.
 
43.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0) 'Textdatei öffnen 
44.
Fertig = False 'Schalter initialisieren 
45.
Import = False 'Schalter initialisieren 
46.
Do While Not DateiEin.AtEndOfStream And Not Fertig 
47.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
48.
    Satz = Replace(Satz, ".", ",") 
49.
    If Import Then 'Satz ist zu importieren 
50.
        If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
51.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
52.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
53.
        Else 
54.
            Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
55.
        End If 
56.
    Else 'bisher wurde nicht importiert - ... 
57.
        If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
58.
            Import = True 'ja; ab jetzt Zeilen importieren 
59.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
60.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
61.
        End If 
62.
    End If 
63.
Loop 
64.
 
65.
Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren 
66.
Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
67.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
68.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
69.
 
70.
SpNr = 12 'Daten ab Spalte L ... 
71.
ZNr = 3 'der Zeile 3 eintragen 
72.
 
73.
 
74.
Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei, 1, 0) 'Textdatei öffnen 
75.
Fertig = False 'Schalter initialisieren 
76.
Import = False 'Schalter initialisieren 
77.
Do While Not DateiEin.AtEndOfStream And Not Fertig 
78.
    Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
79.
    Satz = Replace(Satz, ".", ",") 
80.
    If Import Then 'Satz ist zu importieren 
81.
        If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
82.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
83.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
84.
        Else 
85.
            Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
86.
        End If 
87.
    Else 'bisher wurde nicht importiert - ... 
88.
        If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
89.
            Import = True 'ja; ab jetzt Zeilen importieren 
90.
            SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
91.
            ZNr = ZNr + 1 'nächste Tabellenzeile 
92.
        End If 
93.
    End If 
94.
Loop 
95.
DateiEin.Close 'Textdatei schließen 
96.
End Sub 
97.
 
98.
Sub SatzEintragen(D, Z, S) 
99.
Do While InStr(D, "  ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ... 
100.
    D = Replace(D, "  ", " ") ' ... diese durch ein einzelnes ersetzen 
101.
Loop 
102.
Felder = Split(D) 'Zeile in Felder zerlegen 
103.
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen 
104.
End Sub 
105.
 
Zuerst lief es auch (mit ca. 10 Makros), aber irgendwann um so mehr Makros ich hineinkopierte und testete ging mit mal nichts mehr. (Habe ich öfter versucht.)

Ach ja, auf das 1. Sheet importiere ich eine Tabelle aus einem externen *.vtf-Dokument und ergänze diese dann mit einzelnen Werten aus den importierten unv's (Sheet 2-72). Das Makro für das erste Sheet sitz auf Modul1 im Editor, welches komischerweise als einziges noch funktioniert während die anderen schon nicht mehr gehen.

Hier der Code falls interesse besteht:

01.
Sub ImportDatenAusQuelldatei() 
02.
 
03.
'Zieldatei definieren und aktivieren 
04.
Dim Ziel As String 
05.
Ziel = "Knoten500.xls" 
06.
Workbooks(1).Activate 
07.
 
08.
'Startzeile m in Ziel festlegen 
09.
m = 1 
10.
 
11.
 
12.
'Quelldatei definieren und öffnen 
13.
Dim Quelle As Workbook 
14.
Set Quelle = Workbooks.Open("C:\Users\Brause\Documents\Dokumente Works\Nico FH\IPH\Excel\gesenk.vtf") 
15.
 
16.
Sheets("gesenk").Select 
17.
 
18.
 
19.
'Setzen der Startzeile i der Tabelle gesenk 
20.
i = 8 
21.
 
22.
'Ermitteln der letzten Zeile in gesenk, die Daten enthält 
23.
Dim LZ As Long 
24.
LZ = IIf(IsEmpty(Sheets("gesenk").Range("A65536")), Sheets("gesenk").Range("A65536").End(xlUp).Row, 65536) 
25.
 
26.
'Das zeilenweise einlesen von Quelle nach Ziel soll bis zur letzten Zeile von Quelle erfolgen 
27.
Do Until i > LZ 
28.
 
29.
'Definition der Spalten in Quelle 
30.
A = Quelle.Sheets("gesenk").Cells(i, 1).Text 
31.
B = Quelle.Sheets("gesenk").Cells(i, 2).Text 
32.
C = Quelle.Sheets("gesenk").Cells(i, 3).Text 
33.
D = Quelle.Sheets("gesenk").Cells(i, 4).Text 
34.
E = Quelle.Sheets("gesenk").Cells(i, 5).Text 
35.
 
36.
'Zieltabelle aktivieren 
37.
Workbooks(1).Activate 
38.
Sheets("ziel").Select 
39.
 
40.
'Schreiben der Spalten in neue Spaltenposition A nach A, B nach B, C nach C, D nach D, E nach D 
41.
Workbooks(1).Sheets("ziel").Cells(m, 1) = A 
42.
Workbooks(1).Sheets("ziel").Cells(m, 2) = B 
43.
Workbooks(1).Sheets("ziel").Cells(m, 3) = C 
44.
Workbooks(1).Sheets("ziel").Cells(m, 4) = D 
45.
'Workbooks(1).Sheets("ziel").Cells(m, 5) = E 
46.
 
47.
m = m + 1 
48.
i = i + 1 
49.
 
50.
Loop 
51.
 
52.
Quelle.Close 'Quelldatei schließen 
53.
 
54.
Call Tabelle2.inc0 
55.
Call Tabelle46.inc1 
56.
'Call Tabelle45.inc2 
57.
'Call Tabelle44.inc3 
58.
'Call Tabelle43.inc4 
59.
'Call Tabelle42.inc5 
60.
'Call Tabelle41.inc6 
61.
'Call Tabelle40.inc7 
62.
'Call Tabelle39.inc8 
63.
'Call Tabelle38.inc9 
64.
'Call Tabelle37.inc10 
65.
'Call Tabelle63.inc61 
66.
 
67.
MsgBox "Fertig." 
68.
 
69.
End Sub 
70.
 
71.
 
Dieses sollte mein Haupt-Markro werden, welches beim ausführen die anderen Makros callt (es stehen noch nicht alle drin..).

Wahrscheinlich alles viel zu konfus, aber ich hoffe man kann mir so einigermaßen folgen.

Gruß Brause
Bitte warten ..
Mitglied: bastla
12.06.2010 um 01:46 Uhr
Hallo Brauseklaus!

Du könntest es so versuchen:
01.
Sub Alle() 
02.
Datei = "C:\Users\Brause\Documents\Dokumente Works\Nico FH\IPH\Excel\zwei_symetrien\inc" 
03.
Typ = ".unv" 
04.
Trenn = " " 'Leerzeichen als Trennzeichen zwischen den Feldern 
05.
'Trenn = vbTab 'TAB als Trennzeichen zwischen den Feldern 
06.
 
07.
 
08.
For i = 2 To Worksheets.Count 
09.
    Worksheets(i).Activate 
10.
 
11.
    Von = "NORMALSTRESS" 'ab Zeile mit diesem Inhalt importieren 
12.
    Bis = "FLOWSTRESS" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
13.
 
14.
    SpNr = 1 'Daten ab Spalte A ... 
15.
    ZNr = 3 'der Zeile 3 eintragen 
16.
 
17.
 
18.
    Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen 
19.
    Fertig = False 'Schalter initialisieren 
20.
    Import = False 'Schalter initialisieren 
21.
    Do While Not DateiEin.AtEndOfStream And Not Fertig 
22.
       Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
23.
        Satz = Replace(Satz, ".", ",") 
24.
        If Import Then 'Satz ist zu importieren 
25.
            If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
26.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
27.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
28.
            Else 
29.
                Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
30.
            End If 
31.
        Else 'bisher wurde nicht importiert - ... 
32.
            If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
33.
                Import = True 'ja; ab jetzt Zeilen importieren 
34.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
35.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
36.
            End If 
37.
        End If 
38.
    Loop 
39.
 
40.
    Von = "TEMPERATURE" 'ab Zeile mit diesem Inhalt importieren 
41.
    Bis = "32700" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
42.
 
43.
    SpNr = 8 'Daten ab Spalte H ... 
44.
    ZNr = 3 'der Zeile 3 eintragen 
45.
 
46.
 
47.
    Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen 
48.
    Fertig = False 'Schalter initialisieren 
49.
    Import = False 'Schalter initialisieren 
50.
    Do While Not DateiEin.AtEndOfStream And Not Fertig 
51.
        Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
52.
        Satz = Replace(Satz, ".", ",") 
53.
        If Import Then 'Satz ist zu importieren 
54.
            If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
55.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
56.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
57.
            Else 
58.
                Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
59.
            End If 
60.
        Else 'bisher wurde nicht importiert - ... 
61.
            If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
62.
                Import = True 'ja; ab jetzt Zeilen importieren 
63.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
64.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
65.
            End If 
66.
        End If 
67.
    Loop 
68.
 
69.
    Von = "WEAR" 'ab Zeile mit diesem Inhalt importieren 
70.
    Bis = "-1" 'ab Zeile mit diesem Inhalt nicht mehr importieren 
71.
 
72.
    SpNr = 12 'Daten ab Spalte L ... 
73.
    ZNr = 3 'der Zeile 3 eintragen 
74.
 
75.
 
76.
    Set DateiEin = CreateObject("Scripting.FileSystemObject").OpenTextFile(Datei & CStr(i-2) & Typ, 1, 0) 'Textdatei im öffnen 
77.
    Fertig = False 'Schalter initialisieren 
78.
    Import = False 'Schalter initialisieren 
79.
    Do While Not DateiEin.AtEndOfStream And Not Fertig 
80.
        Satz = DateiEin.ReadLine 'Datensatz aus Datei einlesen 
81.
        Satz = Replace(Satz, ".", ",") 
82.
        If Import Then 'Satz ist zu importieren 
83.
            If InStr(Satz, Bis) = 0 Then 'Ende des Datenbereiches noch nicht erreicht 
84.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
85.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
86.
            Else 
87.
                Fertig = True 'Ende des vorgegebenen Bereiches - keine weiteren Daten einlesen 
88.
            End If 
89.
        Else 'bisher wurde nicht importiert - ... 
90.
            If InStr(Satz, Von) > 0 Then '... beginnt hier der Datenbereich? 
91.
                Import = True 'ja; ab jetzt Zeilen importieren 
92.
                SatzEintragen Satz, ZNr, SpNr 'eingelesenen Satz in Tabellenzeile ZNr ab Spalte SpNr eintragen 
93.
                ZNr = ZNr + 1 'nächste Tabellenzeile 
94.
            End If 
95.
        End If 
96.
    Loop 
97.
    DateiEin.Close 'Textdatei schließen 
98.
Next 
99.
End Sub 
100.
 
101.
Sub SatzEintragen(D, Z, S) 
102.
Do While InStr(D, "  ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ... 
103.
    D = Replace(D, "  ", " ") ' ... diese durch ein einzelnes ersetzen 
104.
Loop 
105.
Felder = Split(D) 'Zeile in Felder zerlegen 
106.
Cells(Z, S).Resize(1, UBound(Felder) + 1).Value = Felder 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen 
107.
End Sub
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
Bitte warten ..
Mitglied: Brauseklaus
13.06.2010 um 15:18 Uhr
Hi bastla,

was soll ich sagen, du bist ein Genie. Das Programm läuft super, ich kann jetzt alle 71 unv's in ein Dokument einlesen (Excel 2007). Mit Excel 2003 muss ich Montag testen. Es kommt mir auch so vor als ob die einzelnen Quelldateien jetzt schneller ausgelesen werden, aber das ist vielleicht nur Einbildung.

Wenn die Optimierungen einzig den Vorteil der Verkleinerung des Quellcodes haben, ist es denke ich nicht notwendig.

Tausend Dank nochmal dafür.

Btw: Hast du schon mit Excel 2010 (beta) Erfahrung gemacht? Bringt es möglicherweise Geschwindigkeits-, Bedienungs-, Kompatibilitäts- oder andere Vorteile?
Ich denke gerade über die Anschaffung nach.

Gruß Brause
Bitte warten ..
Mitglied: bastla
13.06.2010 um 15:28 Uhr
Hallo Brauseklaus!

Freut mich, wenn's für Dich passt.

Zu Excel 2010 kann ich leider nix sagen ...

Grüße
bastla
Bitte warten ..
Mitglied: Brauseklaus
04.07.2010 um 21:49 Uhr
Hi bastla,

habe neulich vor lauter Euphorie nicht bemerkt (oder verdrängt), dass nachdem das Programm die vorhandenen .unv’s ausgelesen hat, eine Fehlermeldung „Laufzeitfehler 53-Datei nicht gefunden“ kommt. Ich nehme an, dass das Programm nach weiteren .unv-Datein vergeblich weiter sucht. Ich habe es sonst einfach "Beenden" gedrückt, da der Import ja schon abgeschlossen war. Nun habe ich dieses Makro aber in einer Kette von anderen eingebunden und da es nicht ordentlich beendet wird, starten die Folgenden nicht. Habe schon versucht selbst eine Zählschleife einzubauen, was mir aber nicht gelang.
Vielleicht hast du ja noch einen Tipp für mich.

Gruß Brause
Bitte warten ..
Mitglied: bastla
04.07.2010 um 22:49 Uhr
Hallo Brauseklaus!

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
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
If fso.FileExists(Datei & CStr(i-2) & Typ) Then
(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
Bitte warten ..
Mitglied: Brauseklaus
05.07.2010 um 01:10 Uhr
Hi bastla,
cool das du nochmal hilfst.

Beim Anzeigen der bearbeiteten Dateien im Direktbereich stellte sich heraus, dass das Programm nicht wie die von erhoffte Reihenfolge 0.unv; 1.unv;…….; 70.unv ausliest, sondern bei 1.unv beginnt und somit versucht 71.unv zu finden. Das ist sicherlich die Fehlerursache.
Hast du eine Idee wie man das Programm überreden könnte bei 0.unv zu starten? 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.

Gruß Brause
Bitte warten ..
Mitglied: bastla
05.07.2010 um 08:52 Uhr
Hallo Brauseklaus!

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
Bitte warten ..
Mitglied: Brauseklaus
05.07.2010 um 14:22 Uhr
Hi bastla,

Perfekt! ;)
Das Programm (und die Folgenden) läuft jetzt sauber durch. Was mir allerdings erst jetzt auffällt, ist das alle Werte in Textformat importiert werden.
Müsste das nicht durch Zeile 106 (.Value) verhindert werden?

Gruß Brause
Bitte warten ..
Mitglied: bastla
06.07.2010 um 14:30 Uhr
Hallo Brauseklaus!

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:
01.
Sub SatzEintragen(D, Z, S) 
02.
Do While InStr(D, "  ") > 0 'solange es noch zwei aufeinanderfolgende Leerzeichen im Satz gibt ... 
03.
    D = Replace(D, "  ", " ") ' ... diese durch ein einzelnes ersetzen 
04.
Loop 
05.
Felder = Split(D) 'Zeile in Felder zerlegen 
06.
For j = 0 To UBound(Felder) 
07.
    Cells(Z, S + j).Value = Felder(j) 'in der Zeile Z die Spalten ab Spalte S mit den Feldwerten füllen 
08.
Next 
09.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: Brauseklaus
06.07.2010 um 21:36 Uhr
Hi bastla,

habe deinen Quelltext mal getestet. Die Werte werden jetzt zwar richtig konvertiert aber gleichzeitig mit 10^4 multipliziert. Dieses gleiche Phänomen hatte ich gestern beim testen eines anderen Codes schon einmal ^^

Bin noch auf eine andere Lösungsmöglichkeit gestoßen:

01.
Range("I8:I15000").Select 
02.
    Do Until ActiveCell.Value = "" 
03.
         ActiveCell.Value = ActiveCell.Value * 1 
04.
         ActiveCell.Offset(1, 0).Select 
05.
      Loop
(vor dem "Next" platziert)

Da es eigentlich nur wichtig war diese Spalte umzuwandeln, reicht mir das (vorläufig ;).


Gruß und Danke!

der Brause
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
VB for Applications
gelöst Excel VBA .csv Import in Tabelle x, ab Spalte y

Frage von drimrim zum Thema VB for Applications ...

VB for Applications
gelöst Wie mittels VBA beim Import von CSV dateien das Format aller Zellen auf "Zahl" ändern? (2)

Frage von Glibber4 zum Thema VB for Applications ...

Virtualisierung
VHD Image import VirtualBox (10)

Frage von oGutIT zum Thema Virtualisierung ...

Outlook & Mail
Outlook Export und Import zwischen Windows und Mac

Frage von VoDa81 zum Thema Outlook & Mail ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...