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

afronden datalabel

Status
Niet open voor verdere reacties.
die getdata verziekt de boel.
zet er een enkel aanhalingsteken voor, zodat die comment wordt
In de module van usVerwerking worden de textboxes toch al netjes gevuld.
Ik zou moeten verder zoeken, maar vooral, de celadressen zijn gewijzigd doordat alles nu netjes in een tabel in Admin staat.
Of die afronding ook supplementair iets doet ?
Code:
Sub maenMacro5(control As IRibbonControl)


     Application.ScreenUpdating = False
     [COLOR="#FF0000"]getdata[/COLOR]
     'With usVerwerking
     '    .Top = Application.Top + 525
     '    .Left = Application.Left - 25
     'End With
     usVerwerking.Show False
     Application.ScreenUpdating = True

End Sub
 
De oproep via charts werkt nu ook goed.

Het is nu inderdaad veel overzichtelijker in Admin geregeld maar in de voorbereiding 1e serie stond een verkeerde celverwijzing voor de keuze van de optionButton (1 of 2), hierdoor werden de tekstboxes van de instelwaarden (consensuswaarden) niet goed onthouden.
 
#100 Zou je niet iets met de declaratie kunnen doen, dat je bijvoorbeeld de textboxes als tekst declareert en vervolgens de komma's vervangt door een punt
of zoiets met: if application.decimalseperator= "," then...
 
textboxen zijn op zijn amerikaans, zonder regionale settings, spijtig ... .
 
als allerlaatste regel in de macro "Hoofdprogramma" zou je nog onderstaande kunnen toevoegen.
Die maakt telkens de grafieken opnieuw aan.
Daarbij worden de mangenta-lijnen verborgen, maar als schoonheidsfoutje blijven de gegevens van dat laatste punt nog rechts in dat lijstje weergegeven.
Met die regel erbij, zie je die gegevens ook niet meer
Code:
     Sheets("grafieken").ListObjects("TBL_GrafiekEvents").DataBodyRange.Columns(5).Resize(, 3).ClearContents
 
Dat is een goeie.

Wat nog niet goed werkt is dat de berekende data in usVerwerking niet wordt ververst. Dit zou wel moeten ongeacht de keuze van de OptionButton. De If Then Else in Voorbereiding klopt dan toch niet?

Wat ik ook ontdekte is dat Alles_Even_Groot de volgorde van de grafieken aanpast. Volgens mij had je dat al een keer benoemd maar ik weet ik niet waarom, op één of andere reden was de eerste grafiek iets kleiner geworden en ik dacht dat met Alles_Even_Groot weer goed te krijgen en dat werkte ook wel alleen nu staat grafiek 1 onderaan.
 
Wat nog niet goed werkt is dat de berekende data in usVerwerking niet wordt ververst. Dit zou wel moeten ongeacht de keuze van de OptionButton. De If Then Else in Voorbereiding klopt dan toch niet?
ik weet niet wat je bedoelt, bij het aanroepen wordt toch de laatste gegevens uit de tabel van "Admin" in die userform gezet en als je iets wijzigt in de userform gaat dat per direct naar de tabel. Is het ook de bedoeling dat het nadat de UF op je blad staat en je handmatig de tabel wijzigt, het ook in realtime in de UF wijzigt ?
Voor het programma is de tabel belangrijker dan de UF.
Wie zal er straks hiermee werken ?
Als straks het aantal reeksen stijgt tot bv. 20, zal je niet te veel onderhoudswerken hebben aan zo'n userform ?
Mits goeie beveiliging op je tabblad "Admin" zodat er niet aan de formules geknoeid kan worden, dan zou ik snel die UF vergeten.
 
Na het aanroepen van us worden dus niet de laatste gegevens uit de tabel "Admin" gehaald. Ik heb het dan over de berekende data. De instelwaarden (eerste gedeelte us) gaat nu wel goed. Het middelste gedeelte van usVerwerking bevat de berekeningen van de actuele data en is puur informatief. De inhoud van die tekstboxen kunnen ook niet worden gewijzigd. Alleen het eerstse gedeelte (consensuswaarden) en het laatste gedeelte (boven- en ondergrens) kunnen door de gebruiker worden aangepast. maw het middelste gedeelte usVerwerking is realtime.

Het programma wordt gebruikt door verschillende mensen voor het monitoren van diverse parameters. Ik heb nu een versie waar alleen de grafieken in staan en waar je ook de mogelijk hebt om op verschillende manieren de grafieken uit te kunnen printen (via >Charts, >File, >PrintSetup). Die optie werkt overigens ook nog met de huidige versie behalve dan dat de tabellen naast de grafieken niet meer overeen komen met de grafiek grootte. Maar goed die zou ik kunnen verbergen.
De overige programma's hebben de huidige versie als basis, dat is 1 keer instellen hoeveel grafieken het moeten zijn en dan het zou het programma gebruikt moeten kunnen worden. De grootste is degene met 27 grafieken. Dat wordt dan ook een us met 2x (27x2)+1x (27x3) tekstboxen.

Het idee van het tabblad "Admin" is puur administratief en nu dan ook leidend voor het programma maar het is de bedoeling dat "Admin" Very Hidden wordt. De us zal niet vaak gebruikt worden maar je moet wel die mogelijkheid hebben om aanpassingen te kunnen doen. Het kan namelijk zijn dat een gemiddelde in de loop van de tijd opschuift en daarom in de us moet worden aangepast. Ik weet niet precies waarom je tegen die us bent, het ziet er toch gelikt uit vind ik
 
Laatst bewerkt:
andere insteek maak bovenin je huidige usVerwerking 4 comboboxes waarin er dus tot 4 verschillende series gekozen kunnen worden.
Dan gaat de huidige opzet ook al voor je toekomstige 27 seriën.
Met wat extra programmeerlijntjes ben je er zo van af.
 
Zou kunnen maar het mooie is dat je een overzicht hebt van de consensuswaarde, de real time data en de USL/LSL. Dit in zijn geheel zou ik onder een combobox kunnen doen, want nu heb ik bijvoorbeeld 1 programma voor 1 standaard waarin 27 grafieken in zitten. In de praktijk kunnen het wel 5 standaarden zijn. Als ik dat in 1 programma stop dan wordt het geheel wel heel erg traag ben ik bang.

Ik heb nu al een programma met 16 grafieken en die kon ik met wat inspanning wel maken vanuit het hoogteprogramma, maar dat was nog in de versie voor de klassenmodulen.
 
mijn laatste update
 

Bijlagen

  • afronden numberformat v3.3.xlsm
    363,8 KB · Weergaven: 22
Laatst bewerkt:
cow18 je bent mijn held en ik wil je bij deze bedanken voor alle hulp. Het programma is super geworden.

Ik ben nog wel op zoek naar een oplossing voor de real time data berekeningen in de usVerwerking. Zoals het programma nu is wordt die data niet ververst. Het vreemde is als ik getdata in de module Dataverwerking activeer dan wordt de data wel ververst met de enabled data. Nu komt het: getallen <0.0001 worden in de tekstbox weergegeven als: 0
Nog vreemder als usVerwerking open is en ik disable een meetpunt met rechtermuisknop dan worden ook de getallen < 0.0001 goed weergegeven in de desbetreffende tekstbox(en).

Ik heb veel van je geleerd nogmaals dank daar voor.
 
wordt inderdaad iets anders aangestuurd na het aanklikken met rechts via die change event in Data.
Doe er nog een paar nullen bij.
Ofwel moet je die 2 regels vervangen door een versie zoals in je getdata waar je tevreden over bent
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim cKop, cNegeer
     b = (Userform_Check("usverwerking") > 0)                   'usVerwerking is loaded or visible
     If Not b Then Exit Sub                                     'als die UF niet actief is, dan moet je hem niet aanpassen

     Set LO = Me.ListObjects("TBL_Metingen")                    'tabel met je meetresultaten
     Set cKop = LO.HeaderRowRange                               'de koprij
     Set cNegeer = Range("Kop_Negeer")                          'gedefinieerde naam met de negeerkolommen-koppen
     k1 = cNegeer.Column - cKop.Column + 1                      '1e negeerkolomnummer van die tabel
     k2 = cNegeer.Columns.Count                                 'aantal negeerkolommen=aantal series
     Set c = Intersect(Target, LO.DataBodyRange.Columns(k1).Resize(, k2))     'alleen die cellen die veranderd zijn en die in de negeerkolommen staan
     If c Is Nothing Then Exit Sub                              'geen dergelijke cellen

     Arr = Sheets("admin").ListObjects("TBL_Administratie").DataBodyRange.Value     'je data in admin
     For i = 1 To k2                                            'voor iedere serie in realtime aanpassen van gemiddelde en sd
          usVerwerking.Controls("m" & i & "_" & "gem").Value = Format(Arr(i, iCol_Ber_Gem), [COLOR="#FF0000"]"0.00000"[/COLOR])
          usVerwerking.Controls("m" & i & "_" & "sd").Value = Format(Arr(i, iCol_Ber_Stdev), [COLOR="#FF0000"]"0.00000"[/COLOR])
     Next
End Sub
 
Daar ben je dan ongeveer een dag mee bezig om het voor elkaar te krijgen staat het gewoon al in het programma, pff. Het werkt en in de data sheet komen waarschijnlijk toch geen getallen >100 dus als het goed is moet dat met deze notatie en code werken.

Ik puzzel rustig verder, maar het is helaas net allemaal te moeilijk voor mij. De y-as wordt opgebouwd op basis van de kleinste en grootste Y-waarde en mijnmin en mijnmax, echter de USL en LSL worden niet meegenomen. Als die groter en/of kleiner zijn dan de grootste en/of kleinste Y-waarden zijn ze niet zichtbaar in de grafiek.

Eén van de afkeuren van een meetpunt is nu >3s en/of <3s. Dat is goed behalve als de USL en LSL zijn geselecteerd dan zijn deze grenzen leidend. Als nu een meetpunt >3s (al dan niet ingesteld of real time) kleiner is dan de USL wordt dit punt rood en dat zou niet moeten. Pas als het meetpunt idg > USL dan pas rood.

Ik weet dat de USL en LSL er pas later bij kwamen en dat is waarschijnlijk de crux, maar ik hoop dat het op te lossen is met de huidige opzet.
 
in hoofdprogramma
Code:
             Else
                         g = data_admin(i, iCol_Ber_Gem)        'Range("Statistiek").Cells(1, i + 15).Value     'je gemiddelde van Y-waarden die gebruikt (!) mogen worden
                         sd = data_admin(i, iCol_Ber_Stdev)     'Range("Statistiek").Cells(2, i + 15).Value     'je standaardafwijking van Y die gebruikt (!) mogen worden
                    End If
                                        
                    [COLOR="#FF0000"]mylsl = data_admin(i, iCol_LSL)
                    Myusl = data_admin(i, iCol_USL)[/COLOR]
                    g = CDbl(g): sd = CDbl(sd)
                    If IsError(sd) Or Not IsNumeric(sd) Then sd = 0.0000000001
                    sd = Application.Max(sd, 0.0000000001)      '-----> min value for sd
                    Sheets("Admin").Visible = False
                    kl = Application.Min(Ywaarden)              'de kleinste van alle Y
                    gr = Application.Max(Ywaarden)              'de grootste van alle Y

                    With .Axes(xlValue, xlPrimary)
                         mijnmin = Application.Min(kl, g - 4 * sd[COLOR="#FF0000"], mylsl[/COLOR])    'je minimum
                         mijnmax = Application.Max(gr, g + 4 * sd[COLOR="#FF0000"], msyusl[/COLOR])     'je maximum
edit :tikfout bij de 2e myusl (een s te veel)
 

Bijlagen

  • afronden numberformat v3.3 (1).xlsm
    349,2 KB · Weergaven: 32
Laatst bewerkt:
Het klopt nog niet, maar zoiets voor de 3s of SL
Code:
                                                  Case Else
                                                       
                                                       btonen = (data_admin(i, iCol_Levels) = 1)     
                                                       ysl = data_admin(i, iCol_USL)     
                                                       If btonen Then
                                                            If Ywaarden(i) > ysl Then
                                                                With .Points(ipts)
                                                                     .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                     .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                     .Border.Color = RGB(255, 0, 0)
                                                                End With
                                                                If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                            End If
                                                       Else
                                                                With .Points(ipts)
                                                                     .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                     .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                     .Border.Color = RGB(255, 0, 0)
                                                                End With
                                                                If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                       
                                                       End If
                                             End Select
 
Aangepast zoals ik denk dat het zou moeten werken
Code:
                                           For ipts = 1 To .Points.Count     'alle punten aflopen en kleuren ngl. afwijking sd
                                             v = Fix((Ywaarden(ipts - 1) - g) / sd)
                                             If Sgn(v) <> Sgn(v1) Then v1 = 0     'SGN = teken (neg=-1, 0=0, pos=+1) als sgn(afwijking) anders is dan tellerstand dan teller terug op nul zetten
                                             If Abs(v) >= s Then v1 = v1 + Sgn(v)     'teller telt +1 bij positieve waarden op, -1 bij negatieve waarden !

                                             Select Case Abs(v)
                                                  Case 0 To 2:  'aan deze moet je niets veranderen, standaard cobalt groene punten en anders groene doorlopende lijnen
                                                       If Abs(v1) >= 4 Then     '4 of meer opeenvolgende punten met een afwijking van meer dan 1 s
                                                            With .Points(ipts)
                                                                 .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                 .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                 .Border.Color = RGB(255, 0, 0)     'voorliggende lijntje rood
                                                            End With
                                                            If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0)     'achterliggende lijntje rood (mag alleen niet van het laatste punt zijn !)
                                                       End If
                                                  Case Else
                                                                btonen = (data_admin(i, iCol_Levels) = 1) 'waarde SL
                                                                ysl = data_admin(i, iCol_USL + iFSC - 1)
                                                                Debug.Print ysl
                                                                        .IsFiltered = Not btonen
                                                                        If btonen Then
                                                                             v = Fix(Ywaarden(ipts - 1) / ysl)
                                                                             Select Case Abs(v)
                                                                             Case 1
                                                                                 With .Points(ipts)
                                                                                      .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                                      .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                                      .Border.Color = RGB(255, 0, 0)
                                                                                 End With
                                                                                 If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                                            End Select
                                                                            ysl = data_admin(i, iCol_USL + iFSC + 1)
                                                                             'v = Fix(Ywaarden(ipts - 1) / ysl)
                                                                             Debug.Print ysl
                                                                             Debug.Print v
                                                                             Select Case Abs(v)
                                                                             Case 1
                                                                                 With .Points(ipts)
                                                                                      .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                                      .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                                      .Border.Color = RGB(255, 0, 0)
                                                                                 End With
                                                                                 If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                                            End Select

                                                                        End If
                                             End Select
Het werkt nog niet goed , alleen de meetpunten >3s en USL gaan goed. Ik maak ergens nog een denkfout. Ik snap de code ylevel ook niet goed.
Code:
ylevel = data_admin(i, iCol_USL + iFSC - 11)     'i=zoveelste grafiek,waarde van die LSL of USL
. Als ik goed tel is dat de Targetwaarde en niet de USL LSL.
 
Laatst bewerkt:
Met onderstaande code lukt het om zowel de positieve usl uitbijter als de negatieve lsl uitbijter rood te kleuren. Het probleem is nu dat als ik checkboxen usl en lsl uitzet alle data uit de grafieken verdwijnt. Is vast logisch maar ik snap niet. Ik hoop dat iemand hier een oplossing voor heeft.
Code:
                                        For ipts = 1 To .Points.Count     'alle punten aflopen en kleuren ngl. afwijking sd
                                             v = Fix((Ywaarden(ipts - 1) - g) / sd)
                                             If Sgn(v) <> Sgn(v1) Then v1 = 0     'SGN = teken (neg=-1, 0=0, pos=+1) als sgn(afwijking) anders is dan tellerstand dan teller terug op nul zetten
                                             If Abs(v) >= s Then v1 = v1 + Sgn(v)     'teller telt +1 bij positieve waarden op, -1 bij negatieve waarden !

                                             Select Case Abs(v)
                                                  Case 0 To 2:  'aan deze moet je niets veranderen, standaard cobalt groene punten en anders groene doorlopende lijnen
                                                       If Abs(v1) >= 4 Then     '4 of meer opeenvolgende punten met een afwijking van meer dan 1 s
                                                            With .Points(ipts)
                                                                 .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                 .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                 .Border.Color = RGB(255, 0, 0)     'voorliggende lijntje rood
                                                            End With
                                                            If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0)     'achterliggende lijntje rood (mag alleen niet van het laatste punt zijn !)
                                                       End If
                                                       btonen = (data_admin(i, iCol_Levels) = 1) 'waarde SL
                                                       yusl = data_admin(i, iCol_USL + iFSC - 1)
                                                       ylsl = data_admin(i, iCol_USL + iFSC + 1)
                                                       .IsFiltered = Not btonen
                                                       If btonen Then
                                                          vusl = Fix(Ywaarden(ipts - 1) / yusl)
                                                          vlsl = Fix(Ywaarden(ipts - 1) / ylsl)
                                                          Select Case Abs(vusl)
                                                            Case 1
                                                               With .Points(ipts)
                                                                    .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                    .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                    .Border.Color = RGB(255, 0, 0)
                                                               End With
                                                               If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                          End Select
                                                          Select Case Abs(vlsl)
                                                             Case 0
                                                                 With .Points(ipts)
                                                                      .MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood
                                                                      .MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood
                                                                      .Border.Color = RGB(255, 0, 0)
                                                                 End With
                                                                 If ipts < .Points.Count Then .Points(ipts + 1).Border.Color = RGB(255, 0, 0) 'maakt lijntje naar punt ook rood!
                                                          End Select
                                                       End If
                                             End Select
                                        Next
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan