Code hängt auf einmal ?
27.09.2012 17:18:47
Johannes
der folgende Code liest die Messwertedateien als *.csv ohne sie explizit zu öffnen. Bisher funktioniert das auch ohne Probleme. Seit heute bleibt der Code immer in Zeile 57 hängen: If IsNumeric(arrDaten(intJ)) Then
Fehlermeldung "Laufzeitfehler 9 Index außerhalb des gültigen Bereichs"
Zusätzlich hätte ich gerne wenn als letzte Information noch der Name der *.csv Datei ganz hinten angehängt werden könnte.
Ich stehe aber "wie Ochs vorm Berg" und bitte um Eure Hilfe. Schon jetzt recht herzlichen Dank dafür.
Ein der *.csv Dateien mls *.xls mit den "Ergebnissen auf Blatt zwei habe ich hochgeladen:
https://www.herber.de/bbs/user/81920.xls
Hier der Code:
Sub Rohdaten_einlesen()
Dim arrRoh, Zeile As Long
Dim arrDaten, intI As Integer, intJ As Integer, Spalte As Long
Dim sFile As String, wksAusw As Worksheet
Const sPfad As String = "C:\Daten Müller\epl MP\Rohdaten\"
Const sPfad2 As String = "C:\Daten Müller\epl MP\Archiv\"
Const sDelim As String = ";"
Application.ScreenUpdating = False
'Auswertedatei öffnen
'Set wksAusw = Workbooks.Open("C:\Daten Müller\epl MP\Auswertung Rohdaten MP epl neu.xls"). _
_
_
Sheets(Rohdaten)
Set wksAusw = Workbooks.Open("C:\Daten Müller\epl MP\Auswertung Rohdaten MP epl neu.xls"). _
Sheets(2)
With wksAusw
If .Cells(.Rows.Count - 1, 1) "" Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
GoTo Beenden
End If
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
sFile = Dir(sPfad & "*.csv")
Do While sFile ""
With wksAusw
Zeile = Zeile + 1
If Zeile >= .Rows.Count Then
MsgBox "Auswertung ist voll!", vbCritical, "ACHTUNG"
Exit Do
End If
Open sPfad & sFile For Input As #1
arrRoh = Split(Input(LOF(1), 1), vbLf)
Close #1
'Name sPfad & sFile As sPfad2 & sFile & "_x" 'als verarbeitet kennzeichnen
'stattdessen gründlich löschen
Kill sPfad & sFile
For intI = 0 To UBound(arrRoh)
arrDaten = Split(arrRoh(intI), sDelim)
Select Case intI
Case 0 'Datum und Zeit
Spalte = 1
.Cells(Zeile, Spalte).Value = CDbl(CDate(arrDaten(0)))
Spalte = 2
.Cells(Zeile, Spalte).Value = CDbl(CDate(arrDaten(1)))
Case 1 To 10 ' Kopfdaten 1 bis 10
Spalte = intI + 2
.Cells(Zeile, Spalte).Value = arrDaten(1)
Case 11
'do nothing
Case 12 To 28 'Wert 1 bis 17
For intJ = 1 To 3 ' Ist, Soll und Toleranz
Spalte = 13 + (intJ - 1) * 17 + (intI - 12)
If IsNumeric(arrDaten(intJ)) Then
.Cells(Zeile, Spalte).Value = CDbl(arrDaten(intJ))
Else
If Right(arrDaten(intJ), 1) = "%" Then
If IsNumeric(Left(arrDaten(intJ), Len(arrDaten(intJ)) - 1)) Then
.Cells(Zeile, Spalte).Value = _
CDbl(Left(arrDaten(intJ), Len(arrDaten(intJ)) - 1)) / 100
Else
.Cells(Zeile, Spalte).Value = arrDaten(intJ)
End If
Else
.Cells(Zeile, Spalte).Value = arrDaten(intJ)
End If
End If
Next intJ
End Select
Next
End With
Erase arrDaten, arrRoh
sFile = Dir
Loop
Beenden:
Application.ScreenUpdating = True
wksAusw.Parent.Save
Set wksAusw = Nothing
Sheets("Rohdaten").Select
End Sub