Marting Seniormester
13. januar 2021 - 19:39 Der er 8 kommentarer

En mere enkel / grøn klimavenlig / hurtigere kode (Med Kode)

Hej

Er der en her? : -)

Som kan gøre denne her kode mere enkel / grøn klimavenlig / hurtigere ?
Jeg prøver at ligge koden med ud her , om der ville være mere held, til en mere grøn løsning 😊

Private Sub ComboBox1_Change()
    'Skriver dato for uge nr. beregning
    Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
   
    'Indlæser dag'
    Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
   
    'Indlæser uge nr.
    LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
   
End Sub

Private Sub CommandButton1_Click()
'Slet knap
Application.ScreenUpdating = False
' Denne makro sletter et forudvalgt område (A5:E62)i det aktive ark.
' Udskriften skal bekræftes i en meddelelsesboks.
    Dim bytAns As Long
       
           
      bytAns = MsgBox("Du har anmodet om at slette: A5:E62" & vbCrLf & _
            Worksheets("Hjælpe Ark").Range("H2").Value & " tilføjes som fast dato!" & _
            vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")
   
If bytAns = vbYes Then
        Worksheets("Hjælpe Ark").Range("E3").ClearContents
        Worksheets("Hjælpe Ark").Range("T5:U62").ClearContents
       
        'Henter en ren hjælpe celle fra Hjælpe ark A46
        ' sletter Kørselsrapport A5:E62
        Worksheets("Hjælpe Ark").Range("A46").Copy _
        Destination:=Worksheets("Kørselsrapport").Range("A5:G62")
       
       
       
        'Skriver DagsDato på Hjælpe Ark.
        Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H3").Value

        'Sletter Start tid på dagen / Slut tid på dagen (B66/B67)
       
        'Worksheets("Kørselsrapport").Range("B66").Value = ""
        'Worksheets("Kørselsrapport").Range("B67").Value = ""

       
        'Skriver ugedag - Dato - Uge nr. på Kørselsrapport.
        'Call HentFastNV
        Worksheets("Ark2").Range("B3").Value = Worksheets("Hjælpe Ark").Range("B18").Value
       
   
       
    'Luk Userform
    Unload Me
   
   
    Else
        Exit Sub
    End If
Application.ScreenUpdating = True
End Sub

Private Sub Cb_Idag_Click()
'I dag knap
    'Sætter dato i
    ComboBox1.Value = Worksheets("Hjælpe Ark").Range("L30").Value
   
    'Skriver dato for uge nr. beregning
    Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
   
    'Indlæser dag'
    Label8 = Worksheets("Hjælpe Ark").Range("H9").Value

    'Indlæser uge nr.
    LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
   

End Sub

Private Sub cb_Ok_Click()
'OK knap
   
    'Skriver dato i Hjælpe Ark
    Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
   
    'Hvis A5:E62 er tom, spørges om dato skal slettes
    If Worksheets("Hjælpe Ark").Range("H4") = "Tom" Then
        Dim bytAns As Long
            bytAns = MsgBox("Ark tomt! " & Worksheets("Hjælpe Ark").Range("H8").Value & " tilføjes som fast dato! " & _
            vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")
       
        If bytAns = vbYes Then
         
          Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H8").Value
        Else
         
        'Unload Me

                       
        End If
   
       
    End If
   
    'Henter Skriver ugedag - Dato - Uge nr. på Kørselsrapport.
    Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H8").Value
    Worksheets("Ark2").Range("B3").Value = Worksheets("Hjælpe Ark").Range("B18").Value
   
   
    'Call HentFastNV
    'Luk Userform
   
    Unload Me
End Sub


Private Sub UserForm_Initialize()
ComboBox1.List = Worksheets("Hjælpe Ark").Range("L2:L60").Value
   
    'Til overskrift
    LaOverskrift.Caption = Me.Caption
   
    'Til Navn (Henter fast Navn = B15)
    Label9 = Worksheets("Hjælpe Ark").Range("B15").Value
   
    'Til vogn nr (Henter fast vogn nr. B16)
    Label10 = Worksheets("Hjælpe Ark").Range("B16").Value
   
    'Dato vælger sætter dato i
    ComboBox1.Value = Worksheets("Hjælpe Ark").Range("H3").Value
       
    'Indlæser dag'
    Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
   
    'Indlæser uge nr.
    LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
   

End Sub


under VBA Project
UserForm1
https://www.dropbox.com/s/72fqrwnzjkqsuqh/Dato%20skifter.xlsm?dl=0

Det er en dato skifter, som er i en større kontekst i min kørselsrapport
I hjælpearket henter den dagens dato og en række datoer + - fra dagens dato

Jeg var nød til at konverterer nogen celler,  fra dato til standard celler ellers lavet den rod i det,  når VB skulle hente fra hjælpeark

Eller er gjord så simpelt  at den ikke kan fylde mindre  eller blive mere grøn  : -)

Tænker at den grønne  REM eller hjælpe teksten i koden ikke tæller med i koden  : -)

Håber alt sammen giver lidt mening  : -)
milter Ekspert
13. januar 2021 - 19:46 #1
Hvordan har du tænkt dig, at en ny kode skulle være mere "grøn klimavenlig"?

Jeg kender ikke meget til Excel, men måske kunne du gøre teksten grøn. Så har du da i det mindste løst halvdelen af problemet.

Og undskyld, hvis du betragter mit indlæg som spam, men jeg kunne ikke dy mig :-)
Marting Seniormester
13. januar 2021 - 19:55 #2
milter > Hej  : -)

Ja det er en lang tekst 

det kunne jo være en her der,  kunne se hov den kode kunne gøres mere simpel : -)

Hilsen Martin  G.
milter Ekspert
13. januar 2021 - 20:00 #3
Hej Marting.

Måske mere simpel, men mere "grøn klimavenlig" ? Jeg tvivler stærkt :-)
Marting Seniormester
13. januar 2021 - 20:03 #4
Hej milter

Tænker mere simpel,  automatisk bliver mere klimavenlig  : -)
store-morten Ekspert
13. januar 2021 - 22:01 #5
Hvor er: Kørselsrapport fanen?
store-morten Ekspert
13. januar 2021 - 22:13 #6
Hvor er: HentFastNV?
store-morten Ekspert
13. januar 2021 - 22:32 #7

Private Sub ComboBox1_Change()
    'Skriver dato for uge nr. beregning
        Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
    'Indlæser dag
        Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
    'Indlæser uge nr.
        LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
End Sub


Private Sub CommandButton1_Click()
'Slet knap
Dim bytAns As Long
Application.ScreenUpdating = False
    ' Denne makro sletter et forudvalgt område (A5:E62)i det aktive ark.
    'Udskriften skal bekræftes i en meddelelsesboks.
      bytAns = MsgBox("Du har anmodet om at slette: A5:E62" & vbCrLf & _
            Worksheets("Hjælpe Ark").Range("H2").Value & " tilføjes som fast dato!" & _
            vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")
    'Hvis der svares Ja
        If bytAns = vbYes Then
    'Sletter Hjælpe ark E3 og T5:U62
        Worksheets("Hjælpe Ark").Range("E3,T5:U62").ClearContents
    'Skriver DagsDato på Hjælpe Ark.
        Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H3").Value
       
    ' sletter Kørselsrapport A5:E62
        'Worksheets("Kørselsrapport").Range("A5:G62").ClearContents
    'Sletter Kørselsrapport Start tid på dagen / Slut tid på dagen (B66/B67)
        'Worksheets("Kørselsrapport").Range("B66").Value = ""
        'Worksheets("Kørselsrapport").Range("B67").Value = ""
    'Skriver ugedag - Dato - Uge nr. på Kørselsrapport. (Ark2 ?)
        Worksheets("Ark2").Range("B3").Value = Worksheets("Hjælpe Ark").Range("B18").Value
    'Luk Userform
    Unload Me
     
    Else
        Application.ScreenUpdating = True
        Exit Sub
    End If
        Application.ScreenUpdating = True
End Sub


Private Sub Cb_Idag_Click()
'I dag knap
    'Sætter dato i
        ComboBox1.Value = Worksheets("Hjælpe Ark").Range("L30").Value
    'Skriver dato for uge nr. beregning
        Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
    'Indlæser dag
        Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
    'Indlæser uge nr.
        LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
End Sub


Private Sub cb_Ok_Click()
'OK knap
    'Skriver dato i Hjælpe Ark
        Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
    'Hvis A5:E62 er tom, spørges om dato skal slettes
        If Worksheets("Hjælpe Ark").Range("H4") = "Tom" Then
            Dim bytAns As Long
                bytAns = MsgBox("Ark tomt! " & Worksheets("Hjælpe Ark").Range("H8").Value & " tilføjes som fast dato! " & _
                vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
                "Bekræft fast dato")
    'Hvis der svares Ja
            If bytAns = vbYes Then
              Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H8").Value
            Else
            'Unload Me
            End If
        End If
    'Henter Skriver ugedag - Dato - Uge nr. på Kørselsrapport.
        Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("H8").Value
        Worksheets("Ark2").Range("B3").Value = Worksheets("Hjælpe Ark").Range("B18").Value
    Unload Me
End Sub


Private Sub UserForm_Initialize()
ComboBox1.List = Worksheets("Hjælpe Ark").Range("L2:L60").Value
    'Til overskrift
    LaOverskrift.Caption = Me.Caption
    'Til Navn (Henter fast Navn = B15)
    Label9 = Worksheets("Hjælpe Ark").Range("B15").Value
    'Til vogn nr (Henter fast vogn nr. B16)
    Label10 = Worksheets("Hjælpe Ark").Range("B16").Value
    'Dato vælger sætter dato i
    ComboBox1.Value = Worksheets("Hjælpe Ark").Range("H3").Value
    'Indlæser dag'
    Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
    'Indlæser uge nr.
    LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
End Sub
Marting Seniormester
16. januar 2021 - 06:34 #8
Hej store-morten  : -)

lige lidt kort her fra : -)
ligger lige den færdig prøve V op her : -)

jeg kigger lige nærmere på koden  (senere i weekenden )

kunne men ikke lave de samme indlæsninger fx

'Skriver dato for uge nr. beregning
        Worksheets("Hjælpe Ark").Range("H8").Value = ComboBox1
    'Indlæser dag
        Label8 = Worksheets("Hjælpe Ark").Range("H9").Value
    'Indlæser uge nr.
        LaUgeNr = "Uge Nr.: " & Worksheets("Hjælpe Ark").Range("H10").Value
De ligger et sted

Så men lige henter det et sted og tilbage igen : -)

Så kunne vi måske spare lidt kode der : -)

lidt fra C++ (Har  du forøvrigt erfaring med den slags ) ???  : -)

Kunne men ikke lave noget med lignende med goto indlæg
https://www.programiz.com/cpp-programming/break-statement

På tros af goto er gammeldags 
https://www.programiz.com/cpp-programming/goto

Her er den prøve version

https://www.dropbox.com/scl/fi/8htbst4ww0cqkyr05mztg/F-rdig-pr-ve-version.xlsm?dl=0&rlkey=s0ezd3fiidjb9gqt05n6maigl

Hilsen Martin G.
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Premium
IBM fortsætter offensiv opkøbsstrategi: Køber en af de største og ældste multicloud-leverandører i USA
IBM opkøber cloud-virksomheden MSP Taos. Det er blot det seneste opkøb fra IBM i jagten på de store cloud-giganter og falder i tråd med IBM's offensive hybrid cloud-strategi.
Computerworld
IBM vinder millionaftale om nyt toldsystem
Skatteforvaltningen har tegnet en tiårig kontrakt IBM om levering af det sidste it-system til i en omfattende systemudskiftning i toldsystemerne og som først forventes afsluttet i 2025. Se alle detaljerne her.
CIO
Podcast: Hos Viking Life-Saving Equipment er it gået fra at være backend til at være noget, som kunderne spørger aktivt efter
Podcast, The Digital Edge: Viking leverer en stadig større del af deres produkt som en tjeneste. Som en del af tjenesten tager Viking ansvar for sikkerheden ved at levere, dokumentere og vedligeholde det nødvendige sikkerhedsudstyr. Hør hvordan Henrik Balslev senior digital director hos Viking har løftet den opgave.
Job & Karriere
Microsoft i kæmpe dansk satsning - åbner tre store datacentre i Danmark
Microsoft lancerer kæmpe satsning fra hovedkvarteret i Lyngby. Selskabet åbner tre store bæredygtige datacentre på Sjælland.
White paper
Sådan kan du arbejde effektivt uanset tid, sted og type af enhed
Hvad nu hvis dit arbejde, din information, dine processer og teknologien bag ved, var organiseret på en måde så det passede til din organisation – alt sammen guidet af en intelligent udgave af det digitale arbejdsrum? Det er visionen bag Atea og Citrix´s samarbejde med digital workspace – en smartere og mere effektiv måde at arbejde på. I dette whitetpaper kan du derfor læse om, hvordan du kan skabe et mere effektivt og brugervenligt arbejdsrum uanset tid, sted og enhed. En løsning der på en gang er både enkel og som sætter brugeren i centrum.