Guten Tag,
Ich habe ein Problem mit meiner VBA Programmierung und ich hoffe, dass ich hier Hilfe finde.
Meine VBA Kenntnisse sind so mittelmäßig, jedoch finde ich meistens was ich suche und kann es dann für mich nutzen. Nun habe ich das Problem, dass mir die Schleife den Arbeitsspeicher zunehmend belegt und nach 150+ Durchläufen stehen bleibt.
Ich denke, dass es an den Arrays liegt, die zur Konvertierung erstellt werden und dann anscheinend beim Schließen der Datei nicht gelöscht werden, jedoch finde ich nichts im Netz, was mir bei dem Problem weiter hilft.
Ich hoffe ihr könnt mir Helfen.
Mit freundlichem Gruß
der Mobs
hier der Teil des Skriptes mit der Schleife. In fett mein vermeidlicher Übeltäter.
Sub Tempverlauf_Neu()
Dim strPath As String
Dim inti As Integer
Dim fso As Object, File As Object
Dim i As Integer
Dim a As String
Dim FileY As String
Dim FileX As String
Dim letztezeile As Integer
Dim outmin As Single
Dim r As Integer
Dim v As Integer
Dim FileZ As String
Dim e As Integer
Dim k As Integer
Dim j As Integer
Dim Datum As String
Datum = (Format(Date, "YYMMDD"))
a = "Spannung und Temperatur"
i = 1
' Verzeichnis Speicherort der Daten
FileY = "...\"
' Verzeichnis der zu ladenen Datei
FileX = "...\"
Application.ScreenUpdating = False
' //Zuerst wird die Anzahl der Dateien ermittelt, die sich in dem Ordner befinden, der ausgewertet werden soll.//
' Ordnerpfan angeben
strPath = FileX
Set fso = CreateObject("Scripting.FileSystemObject")
For Each File In fso.GetFolder(strPath).Files
' hier die Auswahl der Dateien, die gezählt werden sollen
If fso.GetExtensionName(File) = "TXT" And Left(File.Name, 4) = "Span" Then inti = inti + 1
Next File
Set fso = Nothing
' // Hier wird eine .TXT Datei in Excel geöffnet
' TXTDateiOeffnen Makro
'
'
For i = 1 To inti
Application.CutCopyMode = False
Workbooks.OpenText Filename:= _
FileX & "\" & a & i & ".TXT" _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
Semicolon:=True, _
Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1))
' hier fehlt jetzt noch der plot in ein anderes sheet und das beenden der Datei.
' und für jede Textdatei soll am besten ein eigenes excel arbeitsblatt gemacht werden...
'Hier wir die letzte Zeile der Spalte A ermittelt
letztezeile = Worksheets(a & i).Cells(Rows.Count, 1).End(xlUp).Row
'Diagramm erstellen
'
Sheets.Add After:=ActiveSheet
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLines
.SetSourceData Source:=Sheets(a & i).Range("A1:A" & letztezeile)
.FullSeriesCollection(1).Name = "=""Temperatur"""
.FullSeriesCollection(1).Values = "'" & a & i & "'" & "!$A$1:$A$" & letztezeile
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
With ActiveChart.FullSeriesCollection(1)
.MarkerStyle = -4142
End With
With ActiveChart.FullSeriesCollection(1).Format.Line
.Visible = msoTrue
.Weight = 0.25
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = a
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeitverlauf"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Temperatur in Grad"
.Axes(xlValue).AxisTitle.Orientation = xlHorizontal
End With
With ActiveChart.Axes(xlValue)
.MaximumScale = 120
.MinimumScale = 20
End With
With ActiveChart.FullSeriesCollection(1)
.AxisGroup = 2
End With
With ActiveChart.Axes(xlValue).AxisTitle
.Left = 11
.Top = 14.026
End With
With ActiveChart.Axes(xlCategory).AxisTitle
.Left = 603.805
.Top = 450.232
End With
With ActiveChart.PlotArea
.Width = 507.835
.Left = 41.875
.Width = 585.835
End With
ActiveWorkbook.SaveAs Filename:= _
FileY & Datum & "_" & a & i & "_.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks(Datum & "_" & a & i & "_.xlsx").Close savechanges:=False
Next i