Kopiering og fjerning efter udløbsdato
Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=104
Udskrevet den: 19.Apr.2025 kl. 11:31
Emne: Kopiering og fjerning efter udløbsdato
Besked fra: Knud
Emne: Kopiering og fjerning efter udløbsdato
Posteringsdato: 19.Okt.2010 kl. 11:27
|
Jeg mangler en formel der kan kopier en række når denne når en udløbsdato. Samtidig skal den kopiere den udløbede række til et andet ark, findes der sådan en formel?
Fx.
Kolonne D indeholder udløbsdatoer. Når en bestemt dato(udløbsdatoen) nås fjernes rækken og sættes ind på et andet ark, fx ark 2. Er det muligt at lave en sådan formel?
|
Svar:
Besked fra: Allan
Posteringsdato: 19.Okt.2010 kl. 15:59
|
Hej Knud,
Ja, det er muligt, dog ikke med en formel men med VBA.
Prøv at lægge dit ark op i forum, så skal jeg nok kigge på det.
//Allan
|
Besked fra: Knud
Posteringsdato: 20.Okt.2010 kl. 10:18
|
Hej Allan
Tak for din hurtige respons, jeg kan ikke ligge regnearket op da det indeholder oplysninger som ikke må ligge offentligt tilgængeligt. Men Kan du ikke prøve at forklare lidt om hvad en VBA er så kan jeg muligvis selv finde ud af det, eller lavet et eksempel i et lille regneark til mig, det ville være kanon hvis du gad det :-)
|
Besked fra: Knud
Posteringsdato: 20.Okt.2010 kl. 12:07
|
/uploads/99/Test_af_VBA_auto_kopiering.xls">uploads/99/Test_af_VBA_auto_kopiering.xls
Hej Allan
Så vidt jeg kan forstå så er VBA en måde at kode en macro ud over det man kan indspille, er det korretk? Vil jeg så i teorien ikke godt selv kunne kode mit ark hvis du koder det her og så sender koden til mig? Så er det vel bare at kopier koden og så diffinere hvilken kolonne udløbsdatoen sidder i? eller er det ikke så enkelt?
Jeg smider lige et test ark op som vi kan snakke ud fra.
Dem der har overskredet datoen i kolonne D "medlemsskab betalt frem til". De skal når jeg aktivere VBAen flytte sig over på arket passive. Det skal virke sådan at jeg i princippet hver dag skal kunne trykke på knappen og så flytter dem der har overskredet datoen sig. Det bedste var hvis de gjorde det helt uden at jeg skulle gøre noget, altså sådan at regnearket opdatere af sig selv UDEN at man skal trykke på noget som helst. Men det kan vel ikke lade sig gøre?
Det kunne være super hvis du kunne hjælpe mig her :-)
|
Besked fra: Allan
Posteringsdato: 20.Okt.2010 kl. 13:13
|
Hej Knud,
Her er et eksempel, med en knap.
Alle som overskrider datoen for udløb, flyttes til arket 'Passive'
Udløbsdatoen er skrevet i arket, så den kan du ændre som du vil.
/uploads/1/VBA_auto_kopiering.xls - uploads/1/VBA_auto_kopiering.xls
Hvis du trykker ALT + F11 kan du se koden som jeg har lavet, den kan du ændre som du lyster.
'**************************************
DatoRange = "D2:D100" AktiveArkNavn = "Aktive"
PassiveArkNavn = "Passive"
'************************************** Koden kan sættes op til at køre når arket åbnes, vil du have det?
//Allan
|
Besked fra: Knud
Posteringsdato: 20.Okt.2010 kl. 14:41
| Ja det vil jeg rigtigt gerne have hvis den kan stilles op til det :-) Vil du lave den til mig også? det ville være fantastisk hvis du gad :-) Tudsind tak for din hjælp :-) |
Besked fra: Allan
Posteringsdato: 20.Okt.2010 kl. 15:22
|
Intet problem, den er her.
Nu fjernes udløbne datoer automatisk ved åbning af fil.
/uploads/1/VBA_auto_kopiering_v2.xls - uploads/1/VBA_auto_kopiering_v2.xls
//Allan
|
Besked fra: Knud
Posteringsdato: 20.Okt.2010 kl. 15:37
|
Tusind tak Allan :-) Nu har jeg siddet og kigget på det, men jeg kan ikke finde ud af hvordan jeg selv sætter det op, har du et link til et sted hvor jeg kan lære mig selv det? eller har du en vejledning i hvordan jeg laver netop det du lige har lavet? |
Besked fra: Allan
Posteringsdato: 20.Okt.2010 kl. 15:52
|
Hej igen,
Du åbner din fil.
Holder på ALT tasten nede mens du trykker én gang på F11
Nu ser du din fil i venstre siden af skærmen.
 Klik på ThisWorkbook og sæt følgende kode ind i tekstområdet i højre side (Illustreret herover)
Private Sub Workbook_Open()
'*** 20-10-2010 - Excel-regneark.dk *** '************************************** DatoRange = "D2:D100" '** UdlDato = "G1" '** AktiveArkNavn = "Aktive" '** PassiveArkNavn = "Passive" '** '************************************** Application.ScreenUpdating = False
For Each dato In Sheets(AktiveArkNavn).Range(DatoRange).Cells
If dato <> "" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then dato.EntireRow.Cut Sheets(PassiveArkNavn).Range("A2").Insert Shift:=xlDown End If Next dato Sheets(AktiveArkNavn).Range(DatoRange).Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete (xlShiftUp) Sheets(AktiveArkNavn).Range("A1").Activate
End Sub
Nu skal du ændre DatoRange til det omåde dine datoer står i.
AktiveArkNavn er navnet på det ark i din fil som indeholder de aktive, samme procedure følges med PassiveArkNavn
UdlDato er den celle hvor du har din udløbsdato, den kan du naturligvis også ændre.
Gem nu filen.
Næste gang du åbner filen, køres koden.
Virker det for dig?
//Allan
|
Besked fra: Knud
Posteringsdato: 22.Okt.2010 kl. 09:37
|
Hej Allan
Jeg sætter virkelig pris på at du hjælper mig :-)
Det virker ikke :-( nu har jeg sat koden ind i det rigtige ark og ændret den, men uden held, kan du se fejlen?
Private Sub Workbook_Open()
'*** 20-10-2010 - Excel-regneark.dk *** '************************************** DatoRange = "M4:M1504" '** UdlDato = "G1" '** AktiveArkNavn = "Sagsregisrering 2010" '** PassiveArkNavn = "Afsluttede sager 2010" '** '************************************** Application.ScreenUpdating = False For Each dato In Sheets(AktiveArkNavn).Range(DatoRange).Cells If dato <> "" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then dato.EntireRow.Cut Sheets(PassiveArkNavn).Range("A2").Insert Shift:=xlDown End If Next dato Sheets(AktiveArkNavn).Range(DatoRange).Select Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete (xlShiftUp) Sheets(AktiveArkNavn).Range("A1").Activate End Sub |
Besked fra: Allan
Posteringsdato: 22.Okt.2010 kl. 10:31
|
Hej Knud,
Der kan være fejlmuligheder, lad os prøve et par stykker:
For at teste koden mens arket er åbent, kan du gå ind i koden, klikke med musen midt i koden og trykke på F5, så startes koden igen. Virker det nu?
//Allan
|
Besked fra: Knud
Posteringsdato: 22.Okt.2010 kl. 11:05
| JAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA nu virker det :-P FANTASTISK TUSIND TUSIND TUSIND TAK!!!!!!!!!, men kan jeg lave det så den selv sætter dagsdato i feltet hvor jeg skriver udløbsdatoen? |
Besked fra: Knud
Posteringsdato: 22.Okt.2010 kl. 11:54
|
/uploads/99/Screendump.doc">uploads/99/Screendump.doc
Nu holdt det op med at virke???? jeg har taget et screendump, kan du hjælpe Allan? :-(
|
Besked fra: Allan
Posteringsdato: 23.Okt.2010 kl. 10:46
|
Hej Knud,
Ups, det er jo fordi der ikke er nogle datoer som skal flyttes, så fejler koden.
Denne kode skulle tage højde for det
 Private Sub Workbook_Open()
'*** 23-10-2010 - Excel-regneark.dk *** '************************************** DatoRange = "D2:D100" '** UdlDato = "G1" '** AktiveArkNavn = "Aktive" '** PassiveArkNavn = "Passive" '** '************************************** Application.ScreenUpdating = False
For Each dato In Sheets(AktiveArkNavn).Range(DatoRange).Cells If dato <> "" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then dato.EntireRow.Cut Sheets(PassiveArkNavn).Range("A2").Insert Shift:=xlDown End If Next dato Sheets(AktiveArkNavn).Range(DatoRange).Select On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete (xlShiftUp) Sheets(AktiveArkNavn).Range("A1").Activate
End Sub |
Besked fra: Knud
Posteringsdato: 25.Okt.2010 kl. 10:20
Igen TUSIND tak for hjælpen, nu opdagede jeg noget da jeg brugte din kode, hvis jeg undlader at sætte en udløbsdato på nogen så bliver de automatisk slettet og det skal de ikke. Det er ikke altid jeg kan sætte slutdato på og dem uden dato på skal den bare springe over. Kan man det?
|
Besked fra: Knud
Posteringsdato: 26.Okt.2010 kl. 11:18
| Kan man ændre ovenstående kode så den ikke sletter dem der ikke har en udløbsdato og stadig fjerner dem der har overskredet udløbsdatoen? |
Besked fra: Allan
Posteringsdato: 26.Okt.2010 kl. 11:38
|
Hej igen,
Ja, problemet er jo bare at koden sletter de tomme datoer sidst i koden, men jeg kan lave en workaround som fixer problemet.
Alle tomme datoer, bliver midlertidigt lavet om til "-" og sidst i koden lavet som til tomme datoer igen
 Prøv lige at se om det ikke virker for dig.
Private Sub Workbook_Open()
'*** 26-10-2010 - Excel-regneark.dk *** '************************************** DatoRange = "M4:M1504" UdlDato = "G1"
AktiveArkNavn = "Sagsregisrering 2010"
PassiveArkNavn = "Afsluttede sager 2010"
'**************************************
Application.ScreenUpdating = False For Each dato In Sheets(AktiveArkNavn).Range(DatoRange).Cells If dato.Value = "" Then dato.Value = "-" If dato.Value <> "-" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then dato.EntireRow.Cut Sheets(PassiveArkNavn).Range("A2").Insert Shift:=xlDown End If Next dato Sheets(AktiveArkNavn).Range(DatoRange).Select On Error Resume Next Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete (xlShiftUp)
For Each tomdato In Sheets(AktiveArkNavn).Range(DatoRange).Cells
If tomdato.Value = "-" Then tomdato.Value = "" Next tomdato Sheets(AktiveArkNavn).Range("A1").Activate
End Sub //Allan
|
Besked fra: Knud
Posteringsdato: 26.Okt.2010 kl. 15:38
| KÆÆÆÆÆFT du er genial Allan, jeg prøver den af i morgen, men mon ikke den virker :-) |
Besked fra: Allan
Posteringsdato: 26.Okt.2010 kl. 15:43
|
Lad os nu se, vi krydser fingre |
Besked fra: Knud
Posteringsdato: 27.Okt.2010 kl. 10:01
| /uploads/99/Screendump_End_If.doc">uploads/99/Screendump_End_If.docJeg har problemer med End If, kan du se hvad jeg gør forkert? jeg har lavet det Screendump til dig. |
Besked fra: Allan
Posteringsdato: 27.Okt.2010 kl. 12:48
|
Du mangler et linjeskift. Linjen:
If dato.Value <> "-" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then dato.EntireRow.Cut
Skal se således ud:
If dato.Value <> "-" And dato.Value < Sheets(AktiveArkNavn).Range(UdlDato).Value Then
dato.EntireRow.Cut //Allan
|
Besked fra: Knud
Posteringsdato: 27.Okt.2010 kl. 13:44
| JAAAAAAAAAA nu virker det, tak tusind tak allan!!! |
Besked fra: Allan
Posteringsdato: 27.Okt.2010 kl. 13:49
Super, tak for din tilbagemelding 
Jeg tror faktisk at det var min skyld, fordi troede jeg havde opdaget noget smart her i forummet.
Jeg skrev koden i en fin grå boks som sådan ud:
Men når man kopierer teksten forsvinder linjeskiftene..... ikke så godt når det er kode
 For eftertiden skriver jeg koden med blå skrift, sådan:
Dette er en test
Dette er en test ny linje
Jeg håber det løser problemet fremover.
//Allan
|
Besked fra: Knud
Posteringsdato: 27.Okt.2010 kl. 14:09
Det var ikke dig, jeg valgte selv at skrive den ind i "hånd" for at få lidt lidt forståelse for koden :-) jeg glemte selv linieskriftet, eller jeg troede faktisk at det var en fejl af det var der
|
Besked fra: Allan
Posteringsdato: 28.Okt.2010 kl. 10:14
|
Super duper.
Det vigtigste var at det nu virker
 //Allan
|
Besked fra: Knud
Posteringsdato: 29.Okt.2010 kl. 09:01
|
/uploads/99/Screendump_debug.doc">uploads/99/Screendump_debug.doc
Hej Allan
Kan jeg få dig til at hjælpe mig igen? koden er gået i stykker? den virkede i et par dage, men her til morgen skete dette?
 |
Besked fra: Allan
Posteringsdato: 29.Okt.2010 kl. 11:26
|
Hej Knud,
Det kunne godt virke som om navngivningen af dine faner er forkerte øverst i koden.
AktiveArkNavn = "Aktive"
PassiveArkNavn = "Passive"
//Allan
|
Besked fra: Knud
Posteringsdato: 29.Okt.2010 kl. 13:07
|
Hmm må jeg ha kigget på i næste uge, tak for hjælpen endnu en gang
|
Besked fra: Allan
Posteringsdato: 29.Okt.2010 kl. 13:20
|
Super, du vender bare tilbage hvis den stadig fejler.
God weekend!
//Allan
|
Besked fra: Knud
Posteringsdato: 01.Nov.2010 kl. 13:31
|
Så virker det igen :-) jeg tror jeg lader mit testark stå og køre alene i en måneds tid inden jeg sætter koden over i det rigtige ark så jeg sikker på der ikke sker fejl. :-)
Tak for hjælpen
|