AW: txt konvertierung belegt Arbeitsspeicher
02.12.2016 11:35:20
Mobs2b
Guten Tag,
ich habe jetzt deinen Rat beherzigt und das Programm so gut es geht untergliedert. Bin mir nicht sicher, ob das, was ich da geschafft habe 100ig konsequent und sinnvoll war. geht bestimmt noch schöner...
Wichtiger ist auch, dass mein Problem immernoch besteht. Nun die Frage, ob man die schleife noch weiter sinnvoll unterteilen kann oder ob ich sie zwar unterteilt habe, es jedoch keinen sinn ergibt, weil die einzelnen Funktionen nicht genug getrennt voneinander sind...
Bin mir nicht sicher, ob man versteht, was ich damit meine...
hier mal der komplette code
Sub Tempverlauf_Neu()
Dim inti As Integer
Dim i As Integer
Dim letztezeile As Integer
Dim v As Integer
Dim datum As String
Dim a As String
Dim FileY As String
Dim Filex As String
Dim FileZ As String
Dim Filek As String
datum = (Format(Date, "YYMMDD"))
a = "x"
i = 1
v = 10 ' das wievielte Bauteil soll genommen werden? für v einsetzen
'Verzeichnis Speicherort der Daten
FileY = "M:\...Mittag\a\"
'Verzeichnis der zu ladenen Datei
Filex = "M:\...Mittag\"
'Name der Datei für die Zusammenfassung der Graphen
FileZ = "DiaZx" & v & "."
'Name der Datei, in die aus jeder Datei ein Messwert kopiert wurde
Filek = "x"
Application.ScreenUpdating = False
Datacount Filex, inti
For i = 1 To inti
transTxtinExcel Filex, a, i, FileY, datum
letztezeilef a, i, letztezeile
xyDiagrammzeichnen letztezeile, a, i, FileY, datum
Next i
AParaIn1Datei FileY, datum, a, inti
alleBTDia datum, FileZ, v, inti, FileY
Graphenerstellen datum, v, FileY, FileZ, inti
End Sub
Function Datacount(Filex As String, inti As Integer)
'Funktion zum Zählen der Dateien innerhalb eines Ordners
Dim strPath As String
Dim fso As Object
Dim File As Object
' //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
End Function
Function letztezeilef(a As String, i As Integer, letztezeile As Integer)
'Hier wir die letzte Zeile der Spalte A ermittelt
letztezeile = Worksheets(a & i).Cells(Rows.Count, 1).End(xlUp).Row
'Diagramm erstellen
End Function
Function transTxtinExcel(Filex As String, a As String, i As Integer, FileY As String, datum As _
String)
'Function Txt Datei in Excel konvertieren
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))
End Function
Function xyDiagrammzeichnen(letztezeile As Integer, a As String, i As Integer, FileY As String, _
datum As String)
'Dieses Diagramm erstellt auf einem neuen Sheet aus den Werten der ersten Spalte im ersten _
Sheet ein XYDiagramm
Sheets.Add After:=ActiveSheet
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLines
.SetSourceData Source:=Sheets(a & i).Range("A1:A" & letztezeile)
.FullSeriesCollection(1).Name = "=""x"""
.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 = "x"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "x"
.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
End Function
Function AParaIn1Datei(FileY As String, datum As String, a As String, inti As Integer, Filek As _
String)
'Diese Funktion nimmt aus jeder Messdatei jeweils die Bauteiltemperatur, das Spülluftvolumen, _
das Datum und die Zeit zu einem Zeitpunkt,
'der durch die Zelle Vorgegeben wird. Im moment ist es die 5. Zeile.
Dim k As Integer
Dim outmin As Single
Workbooks.Add
Sheets.Add After:=ActiveSheet
k = 1
For k = 1 To inti
Workbooks.Open Filename:= _
FileY & datum & "_" & a & k & "_.xlsx"
Workbooks(datum & "_" & a & k & "_.xlsx").Worksheets(1).Activate
Range(Cells(5, 1), Cells(5, 3)).Copy
Workbooks("Mappe1").Worksheets(1).Activate
Range(Cells(k + 3, 1), Cells(k + 3, 3)).PasteSpecial
Workbooks(datum & "_" & a & k & "_.xlsx").Worksheets(1).Activate
Range(Cells(5, 5), Cells(5, 7)).Copy
Workbooks("Mappe1").Worksheets(1).Activate
Range(Cells(k + 3, 5), Cells(k + 3, 7)).PasteSpecial
Workbooks(datum & "_" & a & k & "_.xlsx").Worksheets(1).Activate
outmin = Application.WorksheetFunction.Min(Range("D1:D200"))
Workbooks("mappe1").Worksheets(1).Cells(k + 4, 4) = outmin
Cells(k + 4, 4) = Round(Cells(k + 4, 4), 2)
Application.CutCopyMode = False
Workbooks(datum & "_" & a & k & "_.xlsx").Close savechanges:=False
Next k
ActiveWorkbook.SaveAs Filename:= _
FileY & datum & Filek & "_" & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Function
Function alleBTDia(datum As String, FileZ As String, v As Integer, inti As Integer, FileY As _
String)
'Diese Funktion kopiert die Messwerte der Bauteiltemperatur von jedem Bauteil, dass im Ordner _
gespeichet ist in eine Datei und speichert diese
'separat ab
Dim b As Integer
Dim c As Integer
Dim e As Integer
Dim a As Integer
a = 1
b = 1
c = inti / v
' Der Dateiname muss an den Speichernamen angepasst werden.
'Neues Excelarbeitsblatt öffnen
Workbooks.Add
Sheets.Add After:=ActiveSheet
' Diagrammblatt erstellen
'eine weitere Variable wird benötigt, da die Dateinamen nun nicht mehr mit den Datenreihen _
zahlen übereinstimmen
e = 1
For e = b To c
Workbooks.Open Filename:= _
FileY & datum & "_xx" & a & "_.xlsx"
Sheets("x" & a).Activate
Sheets("x" & a).Range("A1:A200").Copy
Windows("Mappe2").Activate
Sheets("Tabelle1").Activate
Columns(e).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(datum & "_x" & a & "_.xlsx").Close savechanges:=False
If v = 1 Then
a = a + 1
Else
a = a + v - 1
End If
Next e
ActiveWorkbook.SaveAs Filename:= _
FileY & datum & FileZ & i & "_" & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Function
Function Graphenerstellen(datum As String, v As Integer, FileY As String, FileZ As String, inti _
As Integer)
'Diese Funktion erstellt aus einer beliebig geladenen datei auf einem neuen Sheet aus allen _
werten des ersten sheet ein Diagramm.
'Dabei werden die Daten Spaltenweise in ein XY Diagramm geschrieben.
'Zu beachten ist, dass die Tabelle nicht mehr als 256 Spalten haben darf, da Excel sonst an _
seine Grenze stößt.
Dim b As Integer
Dim c As Integer
Dim j As Integer
b = 1
c = inti / v
j = 1
Sheets.Add After:=ActiveSheet
Charts.Add
ActiveChart.ChartType = xlXYScatterLines
For j = b To c
With Sheets("Diagramm1")
.SeriesCollection.NewSeries
.FullSeriesCollection(j).Values = _
Sheets("Tabelle1").Range(Sheets("Tabelle1").Cells(1, j), Sheets("Tabelle1").Cells(200, _
j))
.FullSeriesCollection(j).Name = "x" & (j - 1) * v + 1
End With
' Sheets("Diagramm1").Axes(xlValue).MajorGridlines.Select
With Sheets("Diagramm1").FullSeriesCollection(j)
.Format.Line.Visible = msoTrue
.Format.Line.Weight = 0.25
.MarkerStyle = -4142
End With
Next j
If v = 1 Then
With Sheets("Diagramm1")
.HasTitle = True
.ChartTitle.Characters.Text = "x " & datum & " x"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "x"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "x"
.Axes(xlValue).AxisTitle.Orientation = xlHorizontal
End With
Else
With Sheets("Diagramm1")
.HasTitle = True
.ChartTitle.Characters.Text = "x " & Format(Date, ("dd.mm.yy")) & " jedes " & v & ". x"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "x"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "x" & vbLf & "x"
.Axes(xlValue).AxisTitle.Orientation = xlHorizontal
End With
End If
With Sheets("Diagramm1").Axes(xlValue).AxisTitle
.Left = 11
.Top = 14.026
End With
With Sheets("Diagramm1").Axes(xlCategory).AxisTitle
.Left = 603.805
.Top = 450.232
End With
With Sheets("Diagramm1").PlotArea
.Width = 507.835
.Left = 41.875
.Width = 585.835
End With
' Daten aus anderer Exceldatei öffnen und ins Diagramm einfügen
'andere Datei schließen
'Datei abspeichern und schließen
ActiveWorkbook.SaveAs Filename:= _
FileY & datum & FileZ & i & "_" & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Function
das Excel ist im übrigen einmal 32 bit und einmal 64 oder 86 bit...
mit freundlichem Gruß
der Mobs