Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C4:C17")) Is Nothing Then Exit Sub Dim t, List For t = 4 To 17 If Cells(t, "C") <> "" Then List = List & "," & Cells(t, "C") Next With Range("F4:F8,F10:F14,F16:F20,F22:F26").Validation ' tilføj selv flere ranges .Delete .Add xlValidateList, Formula1:=List .InCellDropdown = True End With End Sub
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 27.Dec.2014 kl. 18:56
Hej Excelent.
Tak - Det ser rigtigt intersant ud. Lige nu sidder jeg med nogle dumme MsgBoxe, jeg ikke kan få til at åbne på de rigtige kommandoer, men jeg vil prøve din kode lidt senere, når jeg får løst MsgBox problemet.
If Intersect(Target, Range("AB9:AB48")) Is Nothing Then Exit Sub
Dim t, List
For t = 9 To 48
If Cells(t, "AB") <> "" Then List = List & "," & Cells(t, "AB")
Next
'*' Range dropdown liste i Ændr vagter
With Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation ' tilføj selv flere ranges
Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Not Intersect(Target, Range("AB9:AB48")) Is Nothing Then GoTo dvList '*' Ændr klokkeslæt i ark 1 Dim TimeStr As String
On Error GoTo EndMacro If Intersect(Target, Sheets(1).Range("N9:O487, Q9:R487, T9:U487")) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub
Application.EnableEvents = False With Target If .HasFormula = False Then Select Case Len(.Value) Case 1 ' e.g., 1 = 00:01 AM TimeStr = "00:0" & .Value Case 2 ' e.g., 12 = 00:12 AM TimeStr = "00:" & .Value Case 3 ' e.g., 735 = 7:35 AM TimeStr = Left(.Value, 1) & ":" & Right(.Value, 2) Case 4 ' e.g., 1234 = 12:34 TimeStr = Left(.Value, 2) & ":" & Right(.Value, 2) Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45 TimeStr = Left(.Value, 1) & ":" & Mid(.Value, 2, 2) & ":" & Right(.Value, 2) Case 6 ' e.g., 123456 = 12:34:56 TimeStr = Left(.Value, 2) & ":" & Mid(.Value, 3, 2) & ":" & Right(.Value, 2) Case Else Err.Raise 0 End Select .Value = TimeValue(TimeStr) End If End With Application.EnableEvents = True Exit Sub
EndMacro: ActiveCell.Offset(-1, 0).Select: Selection = "" 'Dialog Message QuestionToMessageBox = " Ugyldig indtastning !" & vbNewLine & vbNewLine & " Skriv altid klokkeslættet som et helt tal uden separator." & vbNewLine & " 1 = 00:01" & vbNewLine & " 12 = 00:12" & vbNewLine & " 123 = 01:23" & vbNewLine & " 1234 = 12:34" 'MsgBox Title YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbOKOnly + vbInformation, "Ugyldig indtastning")
Dim t, List For t = 9 To 48 If Cells(t, "AB") <> "" Then List = List & "," & Cells(t, "AB") Next
'*' Range dropdown liste i Ændr vagter With Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation ' tilføj selv flere ranges .Delete .Add xlValidateList, Formula1:=List .InCellDropdown = True End With
End Sub
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 28.Dec.2014 kl. 23:12
Hej Excelent.
Koden virker og udelader tomme celle i dropdown, hvis jeg indtaster List direkte i ark1.
Men List står oprindelig i ark4 og udfyldes via UserForm/TextBoxe, hvor der indtastes i. Alle de vagter der køres.
Hvis jeg overfører List direkte til ark1 fra ark4 vha. lighedstegn, overfører den værdien 0 [nul] fra de tomme celler og de vises som værdien 0 i dropdown.
- ark1.AB9 = ark4.B17
- ark1.AB10 = ark4.B18
- osv.
Hvis jeg overfører List til ark1 fra ark4 vha. formel, overfører den en tom værdi fra de tomme cellerog de vises som tomme mellemrum i dropdown.
- Formel i ark1.AB9: =hvis(Ark4.B17="";"";Ark4.B17)
- osv.
Jeg har prøvet flere forskellige ting i koden, men får Bug med alt jeg prøver. - Jeg skal enten have koden til at hente List direkte fra Ark4. Sheets(4).Range("B17:B84").
- Eller koden skal overføres til ark1, uden tomme værdier.
Den oprindelige List i ark4 er delt op i tre Range, men det betyder ingenting, hvis den er sammenhængende som vist ovenfor. Sheets(4).Range("B17:B36,B46:B55,B75:B84")
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 29.Dec.2014 kl. 09:30
Jeg kom til at tænke på, når Listen er i ark4, skal koden selvfølgelig også stå i ark4 og ikke ark1, hvor Dropboxene er. Det prøver jeg, når jeg kommer hjem fra job. Jeg skal nok give besked om resultatet her.
En hændelses kode trikker ikke når en celles ændres via en formel så den metode kan ikke bruges
Du skal indsætte koden i det ark hvor dvVærdierne indsættes (ark4) ellers køres den ikke
Private Sub Worksheet_Change(ByVal Target As Range) '** Rangen i linien herunder skal svare til den range hvor du overfører værdier via userformen If Not Intersect(Target, Sheets("Ark4").Range("AB9:AB48")) Is Nothing Then GoTo dvList
' din anden kode som jeg ikke har testet
Exit Sub
dvList:
Dim t, List For t = 9 To 48 If Cells(t, "AB") <> "" Then List = List & "," & Cells(t, "AB") Next '** Rangen herunder skal svare til den range hvor dvListerne skal indsættes With Sheets("Ark1").Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation .Delete .Add xlValidateList, Formula1:=List .InCellDropdown = True End With End Sub
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
If Cells(t, "B") <> "" Then List = List & "," & Cells(t, "B")
Next
With Sheets(1).Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation
.Delete
.Add xlValidateList, Formula1:=List
.InCellDropdown = True
End With
End SuB
dvKoden samlet efter klokkeslæt
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Sheets(4).Range("B17:B84")) Is Nothing Then Exit Sub
Dim t, List
For t = 17 To 84
If Cells(t, "B") <> "" Then List = List & "," & Cells(t, "B")
Next
With Sheets(1).Range("L9:L38,L43:L73,L78:L108,L113:L142,L147:L177,L182:L211,L216:L246,L251:L281,L286:L314,L319:L349,L354:L383,L388:L418,L423:L452,L457:L487").Validation
.Delete
.Add xlValidateList, Formula1:=List
.InCellDropdown = True
End With
End SuB
Den måde jeg kan se koden ikke kører, er i Datavalideringsboksen når jeg åbner den.
Den opdaterer ikke linjerne nedenunder i selve valideringsboksen, men viser bare den Range jeg har defineret.
.Delete
.Add xlValidateList, Formula1:=List
Jeg har vedhæftet Test Dropdown 1. - På ark1 kører koden som den skal. - På ark2 er der både KlokkeslætsKode + dvKode.
Bemærk den laver fejl, hvis klokkeslættet tastes med seperator - Det betyder ingenting i det "rigtige ark".
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 30.Dec.2014 kl. 03:58
Her deleter deleter dvKoden ikke tomme værdier i dropdown i ark2.
Heller ikke i den du vedhæftede.
Men jeg kom til at tænke på:
Jeg kan konkludere at, når klokkeslæt og dvKoden står i samme Sub i selve arket, deleter den ikke først tomme værdier fra Listen og herefter lister dem i dropdown, hvis Listen og Dropdown er på hver sin fane.
- I det rigtige ark bliver Listen udfyldt via UserForm.
- Klokkeslæts Koden kører og klokkeslættene bliver ligeledes udfyldt via UserFormen.
Hvis jeg laver et Modul med dvKoden og laver et Call til Modulet, når jeg lukke UserFormen på Gem knappen, kan jeg måske tvinge dvKoden til at køre, så den først fjerne tomme værdier fra Listen og herefter viser værdierne i Dropdown når den aktiveres.
Det vil jeg prøve, når jeg kommer hjem fra job
Men nu først på job og klokken er snart 04, så jeg skal afsted - Hmmmmm..
hvis du vil have dvListerne i Ark2 så skal du tilrette kode :
If Intersect(Target, Sheets("Ark2").Range("C4:C17")) Is Nothing Then Exit Sub
Hvis du vil have dvLister i begge ark, så skal den rettes til følgende :
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C4:C17")) Is Nothing Then Exit Sub
Dim t, List For t = 4 To 17 If Cells(t, "C") <> "" Then List = List & "," & Cells(t, "C") Next
With Range("F4:F8,F10:F14,F16:F20,F22:F26").Validation ' tilføj selv flere ranges .Delete .Add xlValidateList, Formula1:=List .InCellDropdown = True End With With Sheets("Ark2").Range("E10:E20").Validation ' tilføj selv flere ranges .Delete .Add xlValidateList, Formula1:=List .InCellDropdown = True End With
End Sub
Jeg anvender Excel 2016 DK. Hvad anvender DU ? HUSK TILBAGEMELDING !!!
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 31.Dec.2014 kl. 17:58
Hej Excelent.
Svar til dit spørgsmål i dit vedhæftede ark.
Vha. UserFormen indtastes vagtnavne på vagter der køres på henholdsvis Hverdage, Lørdage og Søn- og Helligdage. Der indtastes også vagtstart og vagtslut og alle disse indtastninger bruges af andre funktioner i regnearket.
Fanen er skjult og de celler der ikke modtager værdier fra UserFormen er beskyttede.
I en åben fane der kan tastes i, skal vagtnavnene tastes og disse skal være identisk med de vagtnavne, der blev tastet i den skjulte fane vha. UserFormen, for at lave beregningen korrekt.
Der kan måske være 30 forskellige vagtnavne og derfor en dropdown-liste i fanen, hvor der kan tastes i, så der ikke skal huske på, hvad hver enkelt vagt blev navngivet.
Koden virker perfekt, så lang tid Dropdown fanen er ubeskyttet
Men når fanen beskyttes kommer der Bug på .Add xlValidateList, Formula1:=List
Det er noget med en tillades der skal gives til at Datavalidering må editeres under beskyttet tilstand.
Tilladelse til at Listen overføres til datavalideringen i stedet for den oprindelige Kilde-Range.
Medlem: 15.Apr.2014
Land: Danmark
Status: Offline
Point: 652
Sendt: 02.Jan.2015 kl. 10:15
Hej Excelent.
I det rigtige ark, indtastes først dvListen vha. en UserForm.
Det er alle de vagter der køres og indtastningen er på en fane.
Herefter indtastes de nøjagtig samme vagt-navne i en turnes, fordelt, afhængig af hvordan turnussen er sat sammen. Indtastningen foregår også vha. en UserForm og på en anden fane.
På en tredje fane, der kan tastes direkte i, listes turnussen og den gentager sig året ud.
På denne fane er der mulighed for "vagtbytte" og det var her .InCellDropdown skulle bruges.
-----------------------------
Jeg har prøvet at definere samme dvListe til at vises i Turnus-UserFormens ComboBoxe, ved at bruge dele af din første kode, men det går galt for mig.
Jeg tror dog, jeg har fat i "lidt" af det rigtige, men det er mig komplet ubegribeligt, hvor 3-tallet kommer fra i ComboBoxene !
Er du rar at kigge på den. - Knapper til at åbne indtastning i både dvListen og ComboBoxene er på Ark2. - Indtastningen i ComboBoxene vil listes i Ark2, kolonne H.
- Koden jeg kæmper med, står i UserForm_Dropdown.
- Opdateringen til Userformen er i Module UserForm_Update, men den kører.
Du kan ikke oprette nye emner i dette forum Du kan ikke besvare beskeder i dette forum Du kan ikke slette dine beskeder i dette forum Du kan ikke redigere dine beskeder i dette forum Du kan ikke oprette afstemninger i dette forum Du kan ikke stemme i dette forum