• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Inladen van een .csv bestand dmv macro aanpassen

anton44

Verenigingslid
Lid geworden
20 mei 2005
Berichten
1.804
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?


Screen-20260429_1132-03.jpg

Screen-20260429_1153-06.jpg

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:
Terug
Bovenaan Onderaan