Hilfe bei Datenerfassung benötigt
chris
Ich bin gerade dabei ein Makro zu schreiben um die Daten, die ein Messgerät ausgibt automatisch in ein Excel-File zu importieren, damit diese dort ausgewertet werden können.
Das Messgerät gibt eine Menge an Daten aus, relevant sind für mich nur 2 Dateien:
a) "Datei 1" in der Die Artikelinfos des untersuchten Objektes stehen
b) "Datei 2" Die Unmengen an Daten enthält, etwa 6 Spalten mit bis zu 60'000 Zeilen
Bis jetzt habe ich es geschafft, dass der Nutzer nur den Ordner auswählen muss und mein skript findet die Namen der 2 Dateien selbst heraus und importiert "Datei 1" in das gewünschte Sheet "info".
Mein Problem:
Ich weiss nicht wie ich es nun hinkriege die Daten aus "Datei 2" in das Sheet "data" ab "B2" eingefügt werden. Vielleicht kann mir da jemand helfen?
Option Explicit
Sub Import()
'Ordner Auswählen --------------------------------------------------
Dim strOrdner As String
Dim ORDNER As Characters
Dim Dateiname, Pfad, teil, Datei
Dim Importdatei$, Verzeichnis$, Messdaten$, Importdatei2
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "M:\Projekte\Betriebsversuche_CDP\aktive_Betriebsversuche\LIP\ _
Projekt LIP(ei)\Automatisierung\Makro\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1) "\" Then strOrdner = strOrdner
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then MsgBox ("Kein Ordner gewählt!") Else MsgBox "Ordner ausgewählt:" & _
vbCrLf & strOrdner
'Auswahl zu Ende----------------------------------------------------
'InfoDatei suchen---------------------------------------------------
Datei = Right(strOrdner, 27)
Dateiname = Datei & "_00.dat"
If Dateiname = "" Then MsgBox "Keine Datei gefunden" Else MsgBox "Informationen importiert!" & _
vbCrLf & Dateiname
Application.ScreenUpdating = False
'Suche Beendet------------------------------------------------------
'Import aus Infodatei-----------------------------------------------
Verzeichnis = strOrdner & "/"
On Error Resume Next
ChDir Verzeichnis
Importdatei = Dateiname
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Importdatei, _
Destination:=Range("A1"))
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
.Refresh
End With
'Import beendet-----------------------------------------------------
'Messdaten Suchen---------------------------------------------------
Messdaten = Datei & ".dat"
If Dateiname = "" Then MsgBox "Keine Datei gefunden" Else MsgBox "Messdaten importiert!" & _
vbCrLf & Messdaten
Application.ScreenUpdating = False
'Suche Beendet------------------------------------------------------
'Import von Messdaten-----------------------------------------------
Verzeichnis = strOrdner & "/"
On Error Resume Next
ChDir Verzeichnis
Importdatei2 = Messdaten
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Importdatei2, _
Destination:=Sheets("Tabelle2").Cells(Cells(2, 2)))
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
.Refresh
'Import beendet-----------------------------------------------------
End With
End Sub