anskov Mester
16. maj 2018 - 13:51 Der er 15 kommentarer og
1 løsning

Kør noget af VBA koden hvis D14=1 osv.

Hej Alle

Jeg har nedenstående kode.
Koden skal bruges til at lave indgangskontrol på emner.
2 vigtige ting:
1)Ved ingangskontrol af forskellige emner/vare kan det variere hvor mange stk. ud af et parti man skal lave kontrol af. Dog vil dette antal blive regnet ud og fremgå i en celle.
2) Det vil også variere hvor mange kontrolpunkter man skal lave på en vare. Dog har jeg sat det op så der max laves 6 kontrol punkter på en vare.

Koden kopier den indtastet information, når der bliver trykket på en knap, til et andet ark hvor jeg vil lave noget sortering og statestik osv.
Hver gang der trykkes på knappen kopiers der til næste tomme række.

Det jeg dog gerne vil er følgende:
Hvis vi går ud fra at der skal laves ingangskontrol på 5 emner ud af det modtaget parti, så skal man kunne trykke på knappen 5 gange.

1. gang man trykker så kopier den grund data samt den første kontrols værdier til NÆSTE tomme række. Herudover ligger den +1 til en celle, f.eks. D14 så den kan have styr på hvor mange kontroller der er lavet og til sidst sletter den kontrol værdierne, så der kan skrives nye ind.

2. 3. 4. man trykker kopiers kontrol værdier over, disse indsættes i samme række (DOG som skrevet under punkt 2 varier det hvor mange kontrol punkter der er til en vare. Men jeg sætter det op så der altid er plads til 6 kontrolpunkter. EKSEMPEL: Kontrol 1 vil altid benytte de første 6 KOLLONER (A-F), kontrol 2 værdier vil blive kopieret til 7-14 (G-L) osv. Der ligges +1 til D14 og sletter værdier

5. gang man trykker kopiers kontrol værdier over, og igen til samme række. Alt slettes og dokumentet gemmes og lukkes.

Det eneste jeg er i tvivl om i denne lange smøre er hvordan jeg deler min kode op så når D14 er lig 1 så køres første del af koden. Når D14 er lig 2 så køres anden del af koden og når D14 er lig 5 så køres sidste del af koden.

Jeg er også i tvivl om hvordan jeg får den til at kopier i samme række (Når D14 er større end 1) men tænker det handler om at fjerne +1 fra denne del af koden?
intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke + 1

Nedenstående er min kode, den er noget anderledes end mit forklarende ovenstående eksempel...men hvis i kan vise hvordan man deler koden op, så er det lige meget hvor i deler op henne.

Private Sub CommandButton1_Click()

Dim shtInput As Worksheet
Dim shtOutput As Worksheet
Dim intSidsteraekke As Integer
Dim intInputraekke As Integer

'find sidste række med data så der kopieres ind i næste række
intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke + 1

' kopier fra input til output
Sheets("Rapportering").Cells(intInputraekke, 1) = Sheets("Start").Range("B4").Value
Sheets("Rapportering").Cells(intInputraekke, 2) = Sheets("Start").Range("B6").Value
Sheets("Rapportering").Cells(intInputraekke, 3) = Sheets("Start").Range("B7").Value
Sheets("Rapportering").Cells(intInputraekke, 4) = Sheets("Start").Range("B13").Value
Sheets("Rapportering").Cells(intInputraekke, 5) = Sheets("Start").Range("B15").Value
Sheets("Rapportering").Cells(intInputraekke, 6) = Sheets("Start").Range("B17").Value
Sheets("Rapportering").Cells(intInputraekke, 7) = Sheets("Start").Range("B19").Value
Sheets("Rapportering").Cells(intInputraekke, 8) = Sheets("Start").Range("B21").Value
Sheets("Rapportering").Cells(intInputraekke, 9) = Sheets("Start").Range("B23").Value
Sheets("Rapportering").Cells(intInputraekke, 10) = Sheets("Start").Range("A26").Value
Sheets("Rapportering").Cells(intInputraekke, 11) = Sheets("Start").Range("B34").Value
Range("B34") = Range("B34") + 1
    Range("B4").Select
    Selection.ClearContents
    Range("B6").Select
    Selection.ClearContents
    Range("B13").Select
    Selection.ClearContents
    Range("B15").Select
    Selection.ClearContents
    Range("B17").Select
    Selection.ClearContents
    Range("B19").Select
    Selection.ClearContents
    Range("B21").Select
    Selection.ClearContents
    Range("B23").Select
    Selection.ClearContents
    Range("A26:D32").Select
    Selection.ClearContents
ThisWorkbook.Close savechanges:=True


End Sub
sidwave Ekspert
16. maj 2018 - 14:13 #1
brug CASE
https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/select-case-statement

Select [ Case ] D14 
    D14=1 
        kør kode1 
    Case D14=2
        kør kode 2
  Case D14=5
        kær kode3 
End Select

(noget i den dur)
det er en IF THEN ELSE, med flere punkter
anskov Mester
16. maj 2018 - 14:16 #2
jeg kunne godt tænke mig det sat ind i min formular, jeg er i tvivl hvor og hvordan jeg gør.
sidwave Ekspert
16. maj 2018 - 15:05 #3
fly indholdet af D4 over i en variabel og giv den et navn

så kan du skrive

IF variabel=1 then
  kør noget
else IF
  variabel=2 then
  kør noget
else IF
  variabel=5 then
  kør noget
END IF
anskov Mester
16. maj 2018 - 15:28 #4
Når jeg køre din case metode får jeg en syntax error på første linje "Private Sub CommandButton1_Click()"

Private Sub CommandButton1_Click()

Dim shtInput As Worksheet
Dim shtOutput As Worksheet
Dim intSidsteraekke As Integer
Dim intInputraekke As Integer

Select [ Case ] D14
    D14 = 1
    'find sidste række med data så der kopieres ind i næste række
intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke + 1

Sheets("Rapportering").Cells(intInputraekke, 1) = Sheets("Start").Range("H3").Value

Range("D14") = Range("D14") + 1
       
Case D14 = 2
    intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke


Sheets("Rapportering").Cells(intInputraekke, 2) = Sheets("Start").Range("H4").Value

     

Range("D14") = Range("D14") + 1
     
 
  Case D14 = 3
      intSidsteraekke = Sheets("Rapportering").Cells(Sheets("Rapportering").Rows.Count, "A").End(xlUp).Row
intInputraekke = intSidsteraekke


Sheets("Rapportering").Cells(intInputraekke, 3) = Sheets("Start").Range("H5").Value


Range("D14") = Range("D14") + 1


End Sub
store-morten Ekspert
16. maj 2018 - 20:06 #5
Sub test()
Range("D14").Value = 1

For i = 1 To 5
    Antal = Range("D14").Value
    Select Case Antal
        Case Is = 1
            MsgBox ("Nu udføres " & Antal & ". trin")
            Range("D14") = 2
        Case Is = 2
            MsgBox ("Nu udføres " & Antal & ". trin")
            Range("D14") = 3
        Case Is = 3
            MsgBox ("Nu udføres " & Antal & ". trin")
            Range("D14") = 4
        Case Is = 4
            MsgBox ("Nu udføres " & Antal & ". trin")
            Range("D14") = 5
        Case Is = 5
            MsgBox ("Nu udføres " & Antal & ". trin")
            Range("D14") = 0
    End Select
Next
End Sub
store-morten Ekspert
16. maj 2018 - 20:14 #6
Eller endnu kortere:
Sub test2()

Antal = 1

For i = 1 To 5
    Select Case Antal
        Case Is = 1
            MsgBox ("Nu udføres 1. trin")
            Antal = 2
        Case Is = 2
            MsgBox ("Nu udføres 2. trin")
            Antal = 3
        Case Is = 3
            MsgBox ("Nu udføres 3. trin")
            Antal = 4
        Case Is = 4
            MsgBox ("Nu udføres 4. trin")
            Antal = 5
        Case Is = 5
            MsgBox ("Nu udføres 5. trin")
    End Select
Next
End Sub
store-morten Ekspert
16. maj 2018 - 20:24 #7
Sub test3()

Antal = 1

For i = 1 To 5
    Select Case Antal
        Case Is = 1
            Call Makro_1
            Antal = 2
        Case Is = 2
            Call Makro_2
            Antal = 3
        Case Is = 3
            Call Makro_3
            Antal = 4
        Case Is = 4
            Call Makro_4
            Antal = 5
        Case Is = 5
            Call Makro_5
    End Select
Next
End Sub

Sub Makro_1()
MsgBox ("Nu udføres 1. trin")
End Sub

Sub Makro_2()
MsgBox ("Nu udføres 2. trin")
End Sub

Sub Makro_3()
MsgBox ("Nu udføres 3. trin")
End Sub

Sub Makro_4()
MsgBox ("Nu udføres 4. trin")
End Sub

Sub Makro_5()
MsgBox ("Nu udføres 5. trin")
End Sub
anskov Mester
17. maj 2018 - 12:02 #8
Hej Morten

Angående dit sidste svar.
Så starter du koden sådan her
For i = 1 To 5
    Select Case Antal
        Case Is = 1
            Call Makro_1

To ting:
Første ting, i den kode ved den ikke det er D14 den skal tjekke værdi på vel?

Anden ting:
Nu er det ikke altid at der skal laves 5 gange kontrol.
Men hvis vi nu siger jeg har D14 der tæller hvor mange gange Range("D14") = Range("D14") + 1 der er trykket på knappen og D15 der angiver mange gange kontrol skal udføres (om det er 3,4,5,6,7,8 skal være underordnet). Kan jeg så ikke få den til at sige hvis D14= 1 kør macro 1, hvis D14 større and D14 og mindre end D15 kør makro 2 og til sidst hvis D14=D15 Kør makro 3
anskov Mester
17. maj 2018 - 12:09 #9
Stavefejl, prøver igen:
Kan jeg så ikke få den til at sige hvis
D14= 1 kør macro 1
Hvis D14 større end 1 og mindre end D15 kør makro 2
og til sidst hvis D14=D15 Kør makro 3
store-morten Ekspert
17. maj 2018 - 12:40 #10
Og når D14 > D15 ?
anskov Mester
17. maj 2018 - 12:51 #11
D14>D15 Nej det er lige meget...for hvis D14=D15 så skal den køre makro 3 som til sidst gemmer og lukker arket.
store-morten Ekspert
17. maj 2018 - 12:58 #12
OK, vender tilbage når jeg er ved en pc.
store-morten Ekspert
17. maj 2018 - 16:16 #13
Prøv:
Private Sub CommandButton1_Click()

If Range("D14").Value = 1 Then Makro = 1
If Range("D14").Value > 1 And Range("D14").Value < Range("D15").Value Then Makro = 2
If Range("D14").Value = Range("D15").Value Then Makro = 3

Antal = Makro

    Select Case Makro
        Case Is = 1
            Call Makro_1
            Range("D14").Value = Range("D14").Value + 1
        Case Is = 2
            Call Makro_2
            Range("D14").Value = Range("D14").Value + 1
        Case Is = 3
            Range("D14").Value = 1
            Call Makro_3
    End Select
End Sub

Sub Makro_1()
MsgBox ("Nu udføres 1. makro")
End Sub

Sub Makro_2()
MsgBox ("Nu udføres 2. makro")
End Sub

Sub Makro_3()
MsgBox ("Nu udføres 3. makro")
End Sub
anskov Mester
17. maj 2018 - 19:45 #14
JAMEN det er jo fantastisk....den virker i hverfald med dit eksempel.
Jeg arbejder videre og integrere min kode i dit eksempel.
VIRKELIG fantastisk....TAK :-)
store-morten Ekspert
17. maj 2018 - 19:52 #15
Velbekomme.

Skal den evt. kører automatisk?

ps. slet: Antal = Makro
store-morten Ekspert
17. maj 2018 - 19:58 #16
Som her:
Private Sub CommandButton1_Click()
  Dim Antal As Byte
    Antal = Range("D14").Value
    Do Until Antal > Range("D15").Value

        If Range("D14").Value = 1 Then Makro = 1
        If Range("D14").Value > 1 And Range("D14").Value < Range("D15").Value Then Makro = 2
        If Range("D14").Value = Range("D15").Value Then Makro = 3

    Select Case Makro
        Case Is = 1
            Call Makro_1
            Range("D14").Value = Range("D14").Value + 1
        Case Is = 2
            Call Makro_2
            Range("D14").Value = Range("D14").Value + 1
        Case Is = 3
            Range("D14").Value = 1
            Call Makro_3
    End Select
   
        Antal = Antal + 1
    Loop
End Sub

Sub Makro_1()
MsgBox ("Nu udføres 1. makro")
End Sub

Sub Makro_2()
MsgBox ("Nu udføres 2. makro")
End Sub

Sub Makro_3()
MsgBox ("Nu udføres 3. makro")
End Sub
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
Frank Rasmussen nægter at afvise Hopper stjæler data fra Saphe: "Vi har masser af servere, så jeg ved ikke, hvad det er, jeg skal afvise"
Interview: Telerigmanden Frank Rasmussen tager endnu en gang til genmæle over for konkurrenten Saphe, der beskylder ham for at stjæle data. Han nægter dog at afvise, at det rent faktisk sker. "Vi har masser af servere, så jeg ved ikke, hvad det er, jeg skal afvise," lyder det.
Computerworld
Windows 10's katastrofe-update: Derfor begyndte den pludseligt at slette brugernes filer
Den seneste Windows 10 opdatering kunne i værste fald slette vigtige filer. Microsoft sætter tal på hvor mange der er berørt af den katastrofale fejl.
CIO
Forleden reparerede en mekaniker min bil: Det kostede 4.200 kroner, som min hjerne snød mig til at betale med et smil
De rationelle it-beslutninger du træffer er måske en illusion. Det lærte jeg da min bil gik i stykker og min hjerne snød mig til at tro, at alt var fint. Til gengæld fandt jeg tre fælder dine it-beslutninger kan falde i.
Job & Karriere
Her er syv job-annoncer der overrasker med helt usædvanlige overskrifter
Der er mange ledige it-job i øjeblikket. It-jobbank har her fundet syv spændende stillinger, der har det til fælles, at annoncen har en utraditionel overskrift.
White paper
NY 2018 it-survey: Hvad skaber arbejdsglæde for it-professionelle i Danmark?
it-jobbank og Computerworld har i tæt samarbejde udarbejdet den seneste arbejdsglæderapport for it-professionelle i Danmark. Med mere end 3.000 respondenter får du og din virksomhed et unikt og fyldestgørende indblik i, hvad I skal fokusere på, når I skal rekruttere og ikke mindst fastholde jeres it-medarbejdere. Derudover viser rapporten overraskende, at mere end halvdelen af de adspurgte overvejer at skifte job i løbet af de de næste 24 måneder.