Notifikationer

Markér alle som læst Log ud

frezzer81 Nybegynder

23. maj 2005 - 15:07 Der er 3 kommentarer og
1 løsning

hjælp til macro

Hej Eksperter

Er der mon nogle der kan hjælpe mig med en macro, den skal gøre følgende:

B12 til H12 er stedet hvor man selv har skrevet noget data ind, der skal så være en "opdate" knap som tager det som står i de felter og smider dem lidt længere ned til B17-H17 hvorefter den sletter B12-H12. Når man nu gør det igen skal den kigge efter om der står noget i B17-H17 og hvis der gør skal den nu smide det ind på B18-H18 osv osv, det kan ske at f.eks B17-H17 bliver manuelt slettet, og der skal den så kunne smide næste opdate ind på dens plads så der ik kommer huller nedaf.

http://www.bookselv.dk/excel/ferie.xls
Her er ark'et så det er lidt nemmere at forstå hvad jeg har skrevet.

Synes godt om

frezzer81 Nybegynder

23. maj 2005 - 16:48 #1

fejl

Synes godt om

fagpoler Novice

25. maj 2005 - 08:01 #2

Her er en kode der kan bruges

Sub Feridage()
If [B12] <> "" Then
Range("B12:H12").Select
Selection.Copy
Range("B17").Select
If [B17] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B18").Select
If [B18] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B19").Select
If [B19] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B20").Select
If [B20] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B21").Select
If [B21] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B22").Select
If [B22] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B23").Select
If [B23] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B24").Select
If [B24] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B25").Select
If [B25] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B26").Select
If [B26] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B27").Select
If [B27] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B28").Select
If [B28] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B29").Select
If [B29] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Range("B30").Select
If [B30] = "" Then
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
Exit Sub
End If

Application.CutCopyMode = False
MsgBox "Der er ikke plads til flere"

Exit Sub
End If

MsgBox "Der står ingenting i B12"
End Sub

Synes godt om

fagpoler Novice

25. maj 2005 - 08:14 #3

Lidt forkortet.
Sub Feridage()
Application.ScreenUpdating = False
If [B12] <> "" Then
Range("B12:H12").Select
Selection.Copy

Range("B17").Select
If [B17] = "" Then
GoTo Handling
Exit Sub
End If

Range("B18").Select
If [B18] = "" Then
GoTo Handling
Exit Sub
End If

Range("B19").Select
If [B19] = "" Then
GoTo Handling
Exit Sub
End If

Range("B20").Select
If [B20] = "" Then
GoTo Handling
Exit Sub
End If

Range("B21").Select
If [B21] = "" Then
GoTo Handling
Exit Sub
End If

Range("B22").Select
If [B22] = "" Then
GoTo Handling
Exit Sub
End If

Range("B23").Select
If [B23] = "" Then
GoTo Handling
Exit Sub
End If

Range("B24").Select
If [B24] = "" Then
GoTo Handling
Exit Sub
End If

Range("B25").Select
If [B25] = "" Then
GoTo Handling
Exit Sub
End If

Range("B26").Select
If [B26] = "" Then
GoTo Handling
Exit Sub
End If

Range("B27").Select
If [B27] = "" Then
GoTo Handling
Exit Sub
End If

Range("B28").Select
If [B28] = "" Then
GoTo Handling
Exit Sub
End If

Range("B29").Select
If [B29] = "" Then
GoTo Handling
Exit Sub
End If

Range("B30").Select
If [B30] = "" Then
GoTo Handling
Exit Sub
End If

Application.CutCopyMode = False
MsgBox "Der er ikke plads til flere"

Exit Sub
End If

MsgBox "Der står ingenting i B12"
Exit Sub
Handling:
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
End Sub

Synes godt om

fagpoler Novice

25. maj 2005 - 08:23 #4

Exit sub kan også fjernes når man bruger Go to Handling
Man kan også bruge en lykke, men det synes jeg ikke det kan betale sig her.

Sub Feridage()
Application.ScreenUpdating = False
If [B12] <> "" Then
Range("B12:H12").Select
Selection.Copy

Range("B17").Select
If [B17] = "" Then
GoTo Handling
End If

Range("B18").Select
If [B18] = "" Then
GoTo Handling
End If

Range("B19").Select
If [B19] = "" Then
GoTo Handling
End If

Range("B20").Select
If [B20] = "" Then
GoTo Handling
End If

Range("B21").Select
If [B21] = "" Then
GoTo Handling
End If

Range("B22").Select
If [B22] = "" Then
GoTo Handling
End If

Range("B23").Select
If [B23] = "" Then
GoTo Handling
End If

Range("B24").Select
If [B24] = "" Then
GoTo Handling
End If

Range("B25").Select
If [B25] = "" Then
GoTo Handling
End If

Range("B26").Select
If [B26] = "" Then
GoTo Handling
End If

Range("B27").Select
If [B27] = "" Then
GoTo Handling
End If

Range("B28").Select
If [B28] = "" Then
GoTo Handling
End If

Range("B29").Select
If [B29] = "" Then
GoTo Handling
End If

Range("B30").Select
If [B30] = "" Then
GoTo Handling
End If

Application.CutCopyMode = False
MsgBox "Der er ikke plads til flere"

Exit Sub
End If

MsgBox "Der står ingenting i B12"
Exit Sub
Handling:
ActiveSheet.Paste
Range("B12:H12").Select
Selection.ClearContents
Range("B12").Select
End Sub

Synes godt om

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. Der sættes "nofollow" på alle links.

Følg dette spørgsmål

Opret Preview

Excel kurser

Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Ændre tal i en celle Af xvid i Excel	1	04/09/202616:05	04/09/202616:54
Kan Excel selv beregne alder? Af leahcim i Excel	7	31/08/202610:24	04/09/202602:08
problem med mailbesked Af Pestilensen i Excel	3	24/08/202611:16	28/08/202612:55
Sætte billeder ind i google sheets ark ud fra elev nummer Af lurup i Excel	18	17/08/202615:14	05/09/202622:04
Gemme største værdi Af Lemming@privat.dk i Excel	2	07/08/202622:13	08/08/202609:03

Se alle spørgsmål i kategorien Opret spørgsmål

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

Alle kategorier på Eksperten

Seneste artiklerRSS