• 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.

de x aansluitende dagen met de beste hoogste zonnepanelen opbrengst

Status
Niet open voor verdere reacties.
C

caffie

Gebruiker
Lid geworden
2 jan 2008
Berichten
291
ik wil graag de x (getal 1 tot 9) hoogste opbrengst dagen aan een gesloten opsporen en deze een kleur blauw geven

dus bij het getal 2 de 2 hoogstedagen aan een gesloten.
dus bij het getal 9 de 9 hoogstedagen aan een gesloten.

is is lastiger dan ik dacht

wie o wie heeft hier een oplossing voor
 

Bijlagen

Code: 
Sub hsv()
Dim sv, arr, i As Long, j As Long, x As Long, n As Long, a As Double, b As Double
sv = Range("c9:ag34").Value
ReDim arr(Range("k1") - 1)
 For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x < UBound(sv, 2) Then
         a = a + sv(i, x)
         arr(n) = sv(i, x)
       Else
         a = a + sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
         arr(n) = sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
      End If
     n = n + 1
    Next x
    n = 0
  If a > b Then
    b = a
   cells(4, 13).end(xltoright).clearcontents
   Cells(4, 13).Resize(, Range("k1")) = arr
  End If
    a = 0
  Next j
 Next i
 Cells(1, 16) = b
End Sub

Minder interactie met het blad.
Code: 
Sub hsv()
Dim sv, arr, sv_1, i As Long, j As Long, x As Long, n As Long, a As Double, b As Double, c As Double
sv = Range("c9:ag34").Value
ReDim arr(Range("k1") - 1)
 For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x < UBound(sv, 2) Then
         c = sv(i, x)
       Else
         c = sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
      End If
         a = a + c
         arr(n) = c
         n = n + 1
    Next x
    n = 0
  If a > b Then
    b = a
    sv_1 = arr
  End If
    a = 0
  Next j
 Next i
    Cells(4, 13).resize(,columns.count - 13).ClearContents
    Cells(4, 13).Resize(, Range("k1")) = sv_1
    Cells(1, 16) = b
End Sub
 
Laatst bewerkt:
Wat wil je bereiken ?

Ik geloof niet dat er aaneengesloten dagen zijn die overeenkomen met opeenvolgende opbrengsten qua hoeveelheid.

Kijk in ieder geval het aantal voorwaardelijke opmaakregels na; daar kan nog wat gewied worden.
 
HSV zei:
Code: 
Sub hsv()
Dim sv, arr, i As Long, j As Long, x As Long, n As Long, a As Double, b As Double
sv = Range("c9:ag34").Value
ReDim arr(Range("k1") - 1)
 For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x < UBound(sv, 2) Then
         a = a + sv(i, x)
         arr(n) = sv(i, x)
       Else
         a = a + sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
         arr(n) = sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
      End If
     n = n + 1
    Next x
    n = 0
  If a > b Then
    b = a
   cells(4, 13).end(xltoright).clearcontents
   Cells(4, 13).Resize(, Range("k1")) = arr
  End If
    a = 0
  Next j
 Next i
 Cells(1, 16) = b
End Sub
Klik om te vergroten...

perfect
is snap niet veel van u code maar hij werkt prima
ik ga nog ff puzzelen hoe ik de cellen met de hoogste waarden een kleurtje kan geven
maar dit ziet er goed uit



thanks
 
HSV zei:
Code: 
Sub hsv()
Dim sv, arr, i As Long, j As Long, x As Long, n As Long, a As Double, b As Double
sv = Range("c9:ag34").Value
ReDim arr(Range("k1") - 1)
 For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x < UBound(sv, 2) Then
         a = a + sv(i, x)
         arr(n) = sv(i, x)
       Else
         a = a + sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
         arr(n) = sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
      End If
     n = n + 1
    Next x
    n = 0
  If a > b Then
    b = a
   cells(4, 13).end(xltoright).clearcontents
   Cells(4, 13).Resize(, Range("k1")) = arr
  End If
    a = 0
  Next j
 Next i
 Cells(1, 16) = b
End Sub

Minder interactie met het blad.
Code: 
Sub hsv()
Dim sv, arr, sv_1, i As Long, j As Long, x As Long, n As Long, a As Double, b As Double, c As Double
sv = Range("c9:ag34").Value
ReDim arr(Range("k1") - 1)
 For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x < UBound(sv, 2) Then
         c = sv(i, x)
       Else
         c = sv(i + IIf(i = UBound(sv), 0, 1), x - IIf(x <= UBound(sv, 2), 0, UBound(sv, 2)))
      End If
         a = a + c
         arr(n) = c
         n = n + 1
    Next x
    n = 0
  If a > b Then
    b = a
    sv_1 = arr
  End If
    a = 0
  Next j
 Next i
    Cells(4, 13).resize(,columns.count - 13).ClearContents
    Cells(4, 13).Resize(, Range("k1")) = sv_1
    Cells(1, 16) = b
End Sub
Klik om te vergroten...

op de een of andere manier gaat hij fout aan het eind van de maand
feb. heeft natuurlijk maar 28 dagen
maar ook de maanden met 30 dagen gaan niet helemaal goed
feb zou op zich niet zo erg zijn want daar verwacht je nooit de hoogste opbrengst maar wel in de zomer maanden.

zo lijkt het erop dat hij aan het eind van de maand niet naar de volgende maand kijk maar weer naar het begin van de huidige maand kijken i.p.v. de volgende maand.
Zo ver ik het nu heb kunnen vinden door de variabele uit te lezen die u opvraagt.
 
@Caffie

SVP niet citeren/quoten !
 
Met die 28 dagen zal ik later eens uitvogelen; was me ook niet opgevallen dat het om maanden ging.

Voor nu:
Code: 
For i = 1 To UBound(sv)
  For j = 1 To UBound(sv, 2)
    For x = j To Range("k1") + j - 1
     If x <[COLOR=#ff0000][B]=[/B][/COLOR] UBound(sv, 2) Then
 
ik heb de aanpassing gedaan maar ik weet niet of ik het goed heb gedaan
want hij werk nog beter
waarschijnlijk heb ik wat fout gedaan (ik ben niet zo handig in dit soort dingen - maar blijf het wel proberen)
ik heb de file even opnieuw geplaatst
zo heb ik op op 1 jul 25 kw ingevuld

zodat deze dus de hoogste moet zijn met het getal 2 (zodat hij de hoogste 2 aan een gesloten dagen zoek)
30 jun + 1 jul = 22,029 + 25 = 47,029 (geen elke combinatie van 2 dagen is hoger dan dit getal)
 
Ik was je bijna vergeten.

Code: 
Sub hsv()
Dim sv, arr, sv_1, i As Long, j As Long, x As Long, n As Long, xx As Long, pp As Long, lday As Long, a As Double, b As Double, c As Double
sv = Range("b9:ag34").Value
ReDim arr(0)

 For i = 1 To UBound(sv)
 lday = Day(Application.EoMonth(sv(i, 1), 0))
 xx = 31 - lday
  For j = 2 To UBound(sv, 2)
    For x = j To j + Range("k1") - 1 + IIf(j > j + Range("k1") - 1, xx - 1, 0)
      If x <= lday + 1 Then
         c = sv(i, x)
        Else
         c = sv(i - (x > lday) + (i = UBound(sv)), IIf(x = lday - 1, j, pp + 2))
         pp = pp + 1
      End If
         a = a + c
         If c > 0 Then
           arr(n) = c
           n = n + 1
           ReDim Preserve arr(n)
         End If
     Next x
      n = 0
          If a > b Then
             b = a
             sv_1 = arr
             n = 0
           ReDim arr(0)
        End If
      a = 0
      pp = 0
  Next j
 Next i
 With Cells(4, 13)
    .Resize(, Columns.Count - 13).ClearContents
    .Resize(, Range("k1") + 1) = sv_1
    .Offset(-3, 3) = b
 End With
End Sub
 
Laatst bewerkt:
HSV zei:
Ik was je bijna vergeten.

Code: 
Sub hsv()
Dim sv, arr, sv_1, i As Long, j As Long, x As Long, n As Long, xx As Long, pp As Long, lday As Long, a As Double, b As Double, c As Double
sv = Range("b9:ag34").Value
ReDim arr(0)

 For i = 1 To UBound(sv)
 lday = Day(Application.EoMonth(sv(i, 1), 0))
 xx = 31 - lday
  For j = 2 To UBound(sv, 2)
    For x = j To j + Range("k1") - 1 + IIf(j > j + Range("k1") - 1, xx - 1, 0)
      If x <= lday + 1 Then
         c = sv(i, x)
        Else
         c = sv(i - (x > lday) + (i = UBound(sv)), IIf(x = lday - 1, j, pp + 2))
         pp = pp + 1
      End If
         a = a + c
         If c > 0 Then
           arr(n) = c
           n = n + 1
           ReDim Preserve arr(n)
         End If
     Next x
      n = 0
          If a > b Then
             b = a
             sv_1 = arr
             n = 0
           ReDim arr(0)
        End If
      a = 0
      pp = 0
  Next j
 Next i
 With Cells(4, 13)
    .Resize(, Columns.Count - 13).ClearContents
    .Resize(, Range("k1") + 1) = sv_1
    .Offset(-3, 3) = b
 End With
End Sub
Klik om te vergroten...

Alle eerst
Dank u dat u daar nog te tijd voor weet te vinden.


ik hed je macro geprobeerd
deze loopt vast op de volgende regel


lday = Day(Application.EoMonth(sv(i, 1), 0))


en geeft fout 13 aan
typen komen niet overeen.

zou dit te maken hebben dat ik nog steeds excel 2007 gebruik?

nogmaals bedankt voor alle tijd
 
Ik gebruik ook 2007.
Ik zal vanavond het bestand plaatsen.
Misschien begint de for i iets te vroeg.
Maak van "lday as long" eens "lday as variant".
 
Laatst bewerkt:
snb zei:
@caffie svp niet citeren/quoten
Klik om te vergroten...
Citeren mag natuurlijk best als dat functioneel is voor het bericht. Complete berichten quoten, omdat je te beroerd bent om ofwel de veel grotere knop <Reageer op bericht> aan te klikken, of gelijk in het tekstvak <Snel reageren> te klikken, ja, dan heb je het over een heel ander verhaal. Bovendien is een compleet bericht herhalen gewoon plagiaat, en geen quote. Mogen we de schrijfkosten doorberekenen :).
 
@octa

Daarom citeer ik jou nooit, dat zou te begrotelijk worden. :P
Bovendien zou ik in plaats van 'gelijk', 'meteen' of 'direkt' gebruiken....
 
Laatst bewerkt:
Ik weet het al weer.
Van b9:b34 heb ik datums gemaakt.
Dus 'jun' is 1-6-2018 geworden, enz. enz.

Ps. Die citeerknop mogen ze wat mij betreft verwijderen of direct er naast de reageerknop plaatsen.
 
HSV zei:
Ps. Die citeerknop mogen ze wat mij betreft verwijderen of direct er naast de reageerknop plaatsen.
Klik om te vergroten...

Volledig mee eens met de verwijdersuggestie;
Dat geldt a fortiori voor de knop ernaast: 'op meerdere berichten reageren'
 
Allemaal heel erg bedankt
ik heb de sheet aangepast en nog een keer gepost
Kan iedereen zien hoe het er nu uit ziet en er van leren
Ik heb de code wel iets aangepast en wat toegevoegd
plaats waar de data wordt neer gezet is aangepast
en hij kleurt de cellen met de gevonden data

ik ga het weekend puzzelen hoe deze mooi marco werkt want dit had ik zelf nooit gevonden
En dan ga ik proberen of ik de cellen met de hoogte waarde een kleurtje kan geven
mooie uitdaging voor dit weekend

Nogmaals bedankt.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan