Code verbesseren NUR wenn möglich
25.03.2009 12:12:18
chris
ich habe hier einen code den ich mir selbst zusammengebastelt habe.
Ich weiß auch das man hier sicher sehr viel verbessern kann.
Leider weiß ich nicht wie... deshalb frage ich hier einmal nach ob es möglich ist und mir hierbei jemand helfen könnte.Hintergrund ist der das verschiedene Werte in der *.dat datei stehen und das ich dann die Werte in diesen zeilen oder darunter benötige in der Exceltabelle.
Also deshaln würde ich mich sehr freuen wenn mir jemand helfen könnte.
Da ich nicht die ganze Datei einstelen darf hoffe ich das dieser Code ausreichend ist.
Vielen dank für eure mühen im vorraus.
gruß Chris
Private Sub btn_auswerten_Click()
'Sheet IT-Stand mit den Daten aus *.dat Dateien füllen
Dim start As Long ,Dim lb2 As Long,Dim lbcount As Long,Dim InputData(),Dim Textzeile,Dim X As _
Long,dim z As Long,Dim lz As Long,Dim gekuerzt,Dim fileSaveName
For lb2 = 0 To Me.lb_gefundeneDatfiles.ListCount - 2
'Zeilen in aktueller textdatei zählen
lbcount = 0
start = InStr(Me.lb_gefundeneDatfiles.List(lb2), "\\")
Open Mid(Me.lb_gefundeneDatfiles.List(lb2), start, Len(Me.lb_gefundeneDatfiles.List(lb2)) - _
2) For Input As #1
Do While Not EOF(1)
Line Input #1, Textzeile ' Zeile in Variable einlesen.
lbcount = lbcount + 1
Loop
Close #1
'Array neu Dimensionieren mit Anzahl Zeilen in Textdatei
ReDim InputData(lbcount)
X = 0
Open Mid(Me.lb_gefundeneDatfiles.List(lb2), start, Len(Me.lb_gefundeneDatfiles.List(lb2)) - 2) _
For Input As #1
Do While Not EOF(1)
Line Input #1, InputData(X)
X = X + 1
Loop
Close #1
lz = Vorlage.Worksheets("IT_Stand").Cells(Vorlage.Worksheets("IT_Stand").Rows.Count, 1).End( _
xlUp).Row + 1
'Textdatei array durchgehenund benötigte werte einfügen
For z = 0 To UBound(InputData)
If InStr(1, UCase(InputData(z)), UCase("test1")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 1).NumberFormat = "@"
Vorlage.Worksheets("IT_Stand").Cells(lz, 1).Value = gekuerzt
GoTo naechste
End If
If InStr(1, UCase(InputData(z)), UCase("test2")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 2).NumberFormat = "m/d/yyyy"
Vorlage.Worksheets("IT_Stand").Cells(lz, 2).Value = gekuerzt
GoTo naechste
End If
If InStr(1, UCase(InputData(z)), UCase("test3")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 3).NumberFormat = "[$-F400]h:mm:ss AM/PM"
Vorlage.Worksheets("IT_Stand").Cells(lz, 3).Value = gekuerzt
GoTo naechste
End If
If InStr(1, UCase(InputData(z)), UCase("test4")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 4).NumberFormat = "@"
Vorlage.Worksheets("IT_Stand").Cells(lz, 4).Value = gekuerzt
GoTo naechste
End If
If InStr(1, UCase(InputData(z)), UCase("test5")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 5).NumberFormat = "@"
Vorlage.Worksheets("IT_Stand").Cells(lz, 5).Value = gekuerzt
GoTo naechste
End If
If InStr(1, UCase(InputData(z)), UCase("test6")) > 0 Then
gekuerzt = kuerzen(InputData(z + 2))
Vorlage.Worksheets("IT_Stand").Cells(lz, 6).NumberFormat = "@"
Vorlage.Worksheets("IT_Stand").Cells(lz, 6).Value = gekuerzt
GoTo naechste
End If
naechste:
Next z
Vorlage.Worksheets("IT_Stand").Cells(lz, 7).Value = Mid(Me.lb_gefundeneDatfiles.List(lb2), (Len( _
Me.lb_gefundeneDatfiles.List(lb2)) - 10), 3)
Vorlage.Worksheets("IT_Stand").Cells(lz, 8).Value = Mid(Me.lb_gefundeneDatfiles.List(lb2), (Len( _
Me.lb_gefundeneDatfiles.List(lb2)) - 6), 3)
Next lb2
End Sub
Function kuerzen(werte)
Dim ss
Dim sl
ss = InStr(werte, "Data = ") + 7
sl = Len(werte) - ss
kuerzen = Mid(werte, ss + 1, sl - 1)
End Function
Anzeige