.Asc Dateien mit VBA importieren

Forumthread: .Asc Dateien mit VBA importieren

04.05.2018 11:40:05

Matz

Hallo Leute,
erstmals vielen Dank für dieses super Forum :)
Ich sitze gerade vor einen Problem.
Ich soll jede Menge (so um die 200) .Asc dateien in Excel einlesen ein paar Daten rauskopieren und dann ein Diagramm erstellen.
Ich habe da schon was gemacht aber da müsste ich jede Datei einzeln anwählen.
hier mal mein Code:

Sub Dateiöffnen()
Dim last As Integer
Sheets("Tabelle1").Activate
ChDir _
"C:/temp"
Workbooks.OpenText Filename:= _
Application.GetOpenFilename _
, Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 9), _
Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 1), Array(8,   _
_
9), _
Array(9, 9), Array(10, 9), Array(11, 1)), TrailingMinusNumbers:=True
Range("A1:A23").Select
Selection.Cut
ActiveWorkbook.Close (True)
Windows("Mappe1").Activate
Sheets("Tabelle1").Activate
Range("A1:A23").Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A1").Activate
Selection.Copy
Sheets("33g6").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("35h6").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("40f7").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("40f7").Activate
last = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
ActiveSheet.Cells(last, 2).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("40f7").Activate
last = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1
ActiveSheet.Cells(last, 3).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("45f7").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("45f7").Activate
last = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
ActiveSheet.Cells(last, 2).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("45f7").Activate
last = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1
ActiveSheet.Cells(last, 3).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("45f7").Activate
last = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row + 1
ActiveSheet.Cells(last, 4).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("50h6").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("88h7").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
ActiveWindow.SmallScroll Down:=-12
Range("A13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Länge 134").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Länge 128").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate
Range("A15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Länge 127").Activate
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Cells(last, 1).Select
ActiveSheet.Paste
Sheets("Tabelle1").Activate

Meine Asc datei sieht so aus:

3;Durchmesser;Durchmesser;33.000;-0.009;-0.025;32.984;-0.016; ;-----**----;
4;Durchmesser;Durchmesser;35.000;0.000;-0.016;34.987;-0.013; ;--****-----;
5;Durchmesser;Durchmesser;40.000;-0.025;-0.050;39.959;-0.041; ;----**-----;
6;Durchmesser;Durchmesser;40.000;-0.025;-0.050;39.959;-0.041; ;----**-----;
7;Durchmesser;Durchmesser;40.000;-0.025;-0.050;39.960;-0.040; ;----**-----;
8;Durchmesser;Durchmesser;45.000;-0.025;-0.050;44.962;-0.038; ;-----*-----;
9;Durchmesser;Durchmesser;45.000;-0.025;-0.050;44.961;-0.039; ;----**-----;
10;Durchmesser;Durchmesser;45.000;-0.025;-0.050;44.960;-0.040; ;----**-----;
11;Durchmesser;Durchmesser;45.000;-0.025;-0.050;44.955;-0.045; ;--****-----;
13;Durchmesser;Durchmesser;50.000;0.000;-0.016;49.977;-0.023;-0.007; 14;Durchmesser;Durchmesser;88.000;0.000;-0.035;87.982;-0.018; ;-----*-----;
1;Parallelität;Parallelität;0.000;0.020;0.000;0.018;0.018; ;-----*****-;
1;Abstand Z;Abstand Z;134.000;0.050;-0.050;134.023;0.023; ;-----***---;
2;Abstand Z;Abstand Z;128.000;0.000;-0.100;127.977;-0.023; ;-----****--;
3;Abstand Z;Abstand Z;127.000;0.000;-0.100;126.900;-0.100; ;******-----;
4;Abstand Z;Abstand Z;1.000;0.100;-0.100;1.076;0.076; ;-----*****-;
5;Rundlauf;Lauftoleranz;0.000;0.020;0.000;0.002;0.002; ;-*****-----;
10;Rundlauf;Lauftoleranz;0.000;0.020;0.000;0.011;0.011; ;-----*-----;
14;Konzentrizität;Konzentrizität;0.000;0.020;0.000;0.009;0.009; ;----**-----;
3;Konzentrizität;Konzentrizität;0.000;0.020;0.000;0.004;0.004; ;--****-----;
14;Konzentrizität;Konzentrizität;0.000;0.020;0.000;0.009;0.009; ;----**-----;
3;Konzentrizität;Konzentrizität;0.000;0.020;0.000;0.004;0.004; ;--****-----;
5;Abstand Z;Abstand Z;79.400;0.100;0.000;79.417;0.017; ;--****-----;

mich würde intressieren wie ich beim öffnen auf die einzelnen Spalten einfluss habe.
Aus den aufgenommenen Makro werde ich nicht schlau -.- bzw. kann ich mir das nicht zusammenreimen diesen Prozess zu automatisieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 1. Schritt

04.05.2018 12:18:55

Fennek
AW: 1. Schritt

07.05.2018 07:33:23

Matz
AW: 1. Schritt

07.05.2018 09:57:21

Werner
AW: 1. Schritt

07.05.2018 10:05:43

Matz
AW: 1. Schritt

07.05.2018 10:14:56

Matz
na dann ist ja gut....

07.05.2018 10:19:02

Werner

AW: 1. Schritt

04.05.2018 12:18:55

Fennek

Hallo,
der Code sollte alle asc-Dateien eines ausgewählten Ordners mit Korektur des Dezimal-Trenner jeweils in ein Sheet importieren. Die weitere Auswertung ist für mich zu unklar für einen Code.


Sub Makro1()
' Makro1 Makro
iPath = "c:\temp\" '>>>>>>>>>
iFile = Dir(iPath & "*.asc")
While Len(iFile)
Workbooks.OpenText Filename:=iPath & iFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9,  _
1), _
Array(10, 1), Array(11, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _
TrailingMinusNumbers:=True
iFile = Dir
Loop
'hier die Bearbeitung
End Sub

mfg

AW: 1. Schritt

07.05.2018 07:33:23

Matz

Ich hätte das so eben probiert aber irgendwie will er nicht.
Wenn ich den Code nehme und 1:1 verwenden will bekomme ich eine Fehlermeldung das "Wend" fehlt.
Die Loop schleife hab ich jetzt mal ausgeblendet und ein Weng eingefügt. Passiert aber rein gar nix.

AW: 1. Schritt

07.05.2018 09:57:21

Werner

Hallo,
ersetzte halt mal Loop durch Wend
Gruß Werner

AW: 1. Schritt

07.05.2018 10:05:43

Matz

Das hab ich auch schon probiert. Kommt aber nix

AW: 1. Schritt

07.05.2018 10:14:56

Matz

Problem gefunden -.- Ich habe bei der Pfad angabe übersehen zum schluss ein \ zu setzten.
Vielen dank funzt super :)

na dann ist ja gut....

07.05.2018 10:19:02

Werner

Beliebteste Forumthreads (12 Monate)

Forumthread: .Asc Dateien mit VBA importieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread