anton44
Verenigingslid
- Lid geworden
- 20 mei 2005
- Berichten
- 1.805
Vanaf juni 2025 heb ik prima kunnen draaien met de geboden oplossingen.
Nu heeft Solar Edge (zonnepanelen) het te downloaden databestand gewijzigd waardoor het script niet meer werkt.
Wijziging 1: De bestandsnaam met een vaste naam naar een naam met datum-tijd informatie
Wijziging 2: Het formaat van de .csv informatie van dd-mm-jjjj naar dd mmm. jjjj
De bedoeling was/is om de maximale waarde kW en de bebehorende tijd te vinden die vervolgens in een werkblad te kopiëren. In het onderstaande voorbeeld 3,3 kW om 12:45
Kan het script aangepast worden zodat het met de nieuwe downlad definite (CSV) werkt?


Nu heeft Solar Edge (zonnepanelen) het te downloaden databestand gewijzigd waardoor het script niet meer werkt.
Wijziging 1: De bestandsnaam met een vaste naam naar een naam met datum-tijd informatie
Wijziging 2: Het formaat van de .csv informatie van dd-mm-jjjj naar dd mmm. jjjj
De bedoeling was/is om de maximale waarde kW en de bebehorende tijd te vinden die vervolgens in een werkblad te kopiëren. In het onderstaande voorbeeld 3,3 kW om 12:45
Kan het script aangepast worden zodat het met de nieuwe downlad definite (CSV) werkt?


Code:
Sub Combi()
Dim i, sn, sp, sp1, aOut, x(1 To 2), t, t1, csvPath, s, rij, sPath
With Range("path") 'in welke directory ? zie namen in kopblad !
If .Value = "" Then 'niet opgegeven
sPath = ThisWorkbook.Path 'directory waar dit excelbestand staat. zie namen in kopblad !
Else
sPath = .Value2
End If
End With
sPath = sPath & IIf(Right(sPath, 1) <> "\", "\", "") 'desnoods er nog een "\" achter zetten
s = sPath & Range("CSVbestand").Value2 'te zoeken csv in die subdirectory
csvPath = ZoekImportCSV(s) 'zoeken met aHulpje's methode
If csvPath = "" Then 'niets gevonden
MsgBox "Geen importfile gevonden.", vbCritical, "Foutmelding"
Else
x(2) = -1 'voor te starten zet max op -1
sn = Split(CreateObject("scripting.filesystemobject").opentextfile(csvPath).readall, vbLf) 'open aHulpje's file en splitten op vblf
ReDim aOut(1 To UBound(sn), 1 To 2) 'aanmaak matrix
For i = 1 To UBound(sn)
If Len(sn(i)) Then
sp = Split(Replace(sn(i), Chr(34), ""), ",", 2)
sp1 = Split(Replace(Replace(sp(0), "-", " "), Chr(34), ""))
If UBound(sp1) = 3 Then aOut(i, 1) = CDbl(DateSerial(sp1(2), sp1(1), sp1(0)) + TimeValue(sp1(3)))
aOut(i, 2) = Val(Replace("0" & sp(1), ",", "."))
If aOut(i, 2) > x(2) Then x(2) = aOut(i, 2): x(1) = aOut(i, 1)
End If
Next
With Sheets("Energie") 'op dit blad
rij = Application.IfError(Application.Match(Int(x(1)), .Columns(7), 0), 0) 'bepaal rij, datums staan in kolom 7
If rij = 0 Then 'datum niet gevonden
MsgBox "Datum " & Int(x(1)) & " niet gevonden!", vbCritical, "Waarschuwing"
Else
.Cells(rij, 15) = Round(x(2), 0) 'max waarde afgerond op 0 cijfers
.Cells(rij, 16) = x(1) - Int(x(1)) 'datum (zonder tijd)
Application.Goto .Cells(rij, 7), 1
Kill Left(s, Len(s) - 4) & "*.csv"
End If
End With
End If
Call Cursor_naar_PV
End Sub
Function ZoekImportCSV(csvPath) As String
For i = 10 To 1 Step -1
filenaam = Replace(csvPath, ".csv", " (" & i & ").csv")
If Dir(filenaam) <> "" Then
ZoekImportCSV = filenaam
Exit Function
End If
Next
'Als geen file met volgnummer wordt gevonden dan kijken of er een file zonder volgnummer is.
If ZoekImportCSV = "" Then
If Dir(csvPath) <> "" Then ZoekImportCSV = csvPath
End If
Call Cursor_naar_PV
End Function
Sub Cursor_naar_PV()
If Range("E3") < Range("E7") Then
Call Naar_begin
Else
Application.Goto Cells(Application.Match([E3], Sheets("Energie").Columns(7), 0), 17), -1
ActiveWindow.SmallScroll Down:=-Range("H4")
End If
ActiveWindow.ScrollColumn = 5
End Sub
Bijlagen
Laatst bewerkt: