Heb je hier wat aan?
Het is de bedoeling dat je deze code knipt en plakt in een
module in de VBA editor. Bijvoorbeeld "Module1".
Jij zet alles in "ThisWorkbook". Dat werkt wel, maar het hoort eigenlijk niet
Die plek is bedoeld voor een ander soort programma code.
Dit is trouwens nog niet helemaal af, hoor. Je zal zien dat er aan het eind van de rit veel dubbelingen in staan van datum + tijd stempels. Dat wil je misschien niet. Maar het zal wat inspanning kosten om dat weg te werken. En, omdat het om zoveel gegevens gaat, zal het misschien ook redelijk wat tijd kosten om het hele proces af te ronden.
Eerst maar eens horen of dit gefröbel een beetje past bij wat je voor ogen hebt
Oh. Je start het proces vanuit sub
VerzamelGegevensMain. Maar ik denk dat je dat best snapt. Wat je tot nu toe al gepresteerd hebt.... petje af!
En ook: Je moet even een werkblad toevoegen met de naam
Verzamelblad. Sorry, dat vergat ik te melden.
Een alternatief kan zijn: alle gegevens wel onder elkaar in een paar kolommen zetten en dan in de laatste kolom op iedere regel noemen waar de gegevens vandaan kwamen (
compressor1_druk enzovoort).
Ik heb niet heel veel ervaring met grafieken in Excel, maar mogelijk is een andere opmaak van de gegevens handiger als je het in een grafiek wil zetten.
Edit: Ik ontdekte nog een foutje in de code hieronder. Die heb ik bij deze verbeterd.
Code: Selecteer alles
Option Explicit
Sub VerzamelGegevensMain()
Dim LogGegevens() As Variant
Dim i As Integer
Application.ScreenUpdating = False 'maak het macro sneller door schermverversen uit te zetten
'Gooi eerst alle gegevens van het huidige verzamelblad weg
Sheets("Verzamelblad").Activate
ActiveWindow.FreezePanes = False
Cells.Delete Shift:=xlUp
Range("A1").Select
'Plaats gegevens in de titelrij
Range("A1").Value = "Datum"
Range("B1").Value = "Tijd"
For i = 1 To Sheets.Count 'doorloop alle aanwezige werkbladen en kopieer gegevens naar het verzamelblad als dat van toepassing is
Sheets(i).Select
If ActiveSheet.Name <> "StartBlad" And ActiveSheet.Name <> "Verzamelblad" Then 'deze werkbladen bevatten geen loggegevens en moeten dus worden overgeslagen
Call PlaatsGegevens
End If
Next i
Call SorteerGegevens
'nog wat opmaak zaken
Columns("A:XFD").EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
MsgBox "klaar"
Application.ScreenUpdating = True
End Sub
Sub PlaatsGegevens()
'Deze sub kopieert loggegevens naar het verzamelblad. Datum en tijd komen steeds in kolom A en B. De loggegevens zelf worden naar latere kolommen verschoven.
'Het doel is dat gegevens van 2 verschillende logbestanden nooit in dezelfde kolom komen te staan.
Dim BovensteRij As Long
Dim OndersteRij As Long
Dim LaatsteKolom As Long
Dim BronNaam As String
Dim i As Integer 'hulpteller
OndersteRij = Range("A" & Rows.Count).End(xlUp).Row 'leg vast tot aan welke rij de loggegevens doorlopen
'Gegevens opslaan in computergeheugen
BronNaam = Range("G1").Value
Range("A1:D" & OndersteRij).Select
Selection.Copy
'Gegevens plaatsen op het verzamelblad
Sheets("Verzamelblad").Activate
'hier leg ik wat informatie vast van het bereik waarin de nieuwe gegevens komen te staan
BovensteRij = Range("A" & Rows.Count).End(xlUp).Row + 1
OndersteRij = OndersteRij + BovensteRij - 1
With ActiveSheet
LaatsteKolom = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'Hier plaats ik de naam van de bron van de loggegevens in rij 1. Iedere groep gegevens komt in een aparte kolom, zodat de zaken niet door elkaar gaan lopen
If LaatsteKolom = 2 Then
Cells(1, LaatsteKolom + 1).Value = BronNaam
Else
Cells(1, LaatsteKolom + 2).Value = BronNaam
End If
'Hier worden de gegevens echt geplakt in het werkblad
Range("A" & BovensteRij).Select
ActiveSheet.Paste
'Hier voeg ik lege cellen toe zodat de meetgegevens in de juiste kolomen komen te staan. De bedoeling is dat er nooit gegevens van meerdere bronnen in dezelfde kolom komen te staan.
If LaatsteKolom > 2 Then
Range("C" & BovensteRij & ":C" & OndersteRij).Select
For i = 1 To LaatsteKolom - 1
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
End If
End Sub
Sub SorteerGegevens()
'Deze sub sorteert alle gegevens eerst op datum en dan op tijd.
Dim OndersteRij As Long
Dim LaatsteKolom As Long
OndersteRij = Range("A" & Rows.Count).End(xlUp).Row
With ActiveSheet
LaatsteKolom = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
LaatsteKolom = LaatsteKolom + 1
Range(Cells(2, 1), Cells(OndersteRij, LaatsteKolom)).Select
'Range("A2:L560139").Select >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Dit is niet goed. Zie hieronder de correctie.....
Range(Cells(2, 1), Cells(OndersteRij, LaatsteKolom)).Select
ActiveWorkbook.Worksheets("Verzamelblad").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Verzamelblad").Sort.SortFields.Add2 Key:=Range( _
Cells(2, 1), Cells(OndersteRij, 1)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Verzamelblad").Sort.SortFields.Add2 Key:=Range( _
Cells(2, 2), Cells(OndersteRij, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Verzamelblad").Sort
.SetRange Range(Cells(2, 1), Cells(OndersteRij, LaatsteKolom))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Progress isn't made by early risers. It's made by lazy men trying to find easier ways to do something. - Robert Heinlein