22. marts 2004 - 15:18Der er
8 kommentarer og 1 løsning
selvtænkende regneark, EXCEL FORMLER eller MAKRO?
Hjælp
Jeg skal ha’ lavet en nærmest ”selvtænkende” elektronisk depottjek-formular.
Jeg havde tænkt mig følgende:
Samtlige registreret depoter i en masterfil (ud for hvert depot står hvornår firma-XX de enkelte dage skal tjekke depotet når det er et Fastdepottjek).
Inden afdelingen's sidste person går hjem f.eks. torsdag går personen ind og krydser de enkelte depoter af som skal tjekkes den efterfølgende dag.
Når morgenvagten så åbner filen så står alle de depoter som er faste den pågældende dag øverst i arket (evt. markeret med gult – kunne måske ske v.h.a. F-markeringen i F/A-kolonnen).
Skulle der så blive bestilt et Akut tjek så finder man depotet længere nede på listen. Markere depotet med F, A eller hvad pokker og depotet rykker så automatisk op i øverste del af arket således at det er de depoter som vi den pågældende dag tjekker som altid står øverst.
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3:B65000")) Is Nothing Then On Error GoTo Slut Application.EnableEvents = False If UCase(Target) = "F" Or UCase(Target) = "A" Or UCase(Target) = "F,A" Then OldTarget = Target.Row If OldTarget = 3 Then Range("A" & Target.Row & ":F" & Target.Row).Interior.Color = vbYellow Target = UCase(Target) GoTo Slut End If Target = UCase(Target) Rows(Target.Row).Select Selection.Cut Rows("3:3").Select ' sætter rækken ind som række 3 Selection.Insert Shift:=xlDown Range("A3:F3").Interior.Color = vbYellow ' farvelæg rækken Range("B" & OldTarget).Select Else If OldTarget = 3 Then Range("A" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = xlNone Target = UCase(Target) GoTo Slut End If Range("A" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = xlNone End If End If Slut: Application.EnableEvents = True End Sub
Synes godt om
Slettet bruger
22. marts 2004 - 22:03#2
Tak Kabbak, Det er lige det jeg skal bruge!
Jeg har dog lige et tilægs spørgmål: Er der mulighed for at hvis man sletter F- eller A-markeringen, at cellerne flytter tilbage til deres oprindelige plads?
Synes godt om
Slettet bruger
22. marts 2004 - 22:04#3
Kabbak, Jeg glemte lige at be' dig om at smide et svar, så du kan få dine mere end velfortjente point. :-)
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3:B65000")) Is Nothing Then On Error GoTo Slut Application.EnableEvents = False If UCase(Target) = "F" Or UCase(Target) = "A" Or UCase(Target) = "F,A" Then OldTarget = Target.Row If OldTarget = 3 Then Range("A" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 6 Target = UCase(Target) GoTo Slut End If Target = UCase(Target) Rows(Target.Row).Select Selection.Cut Rows("3:3").Select ' sætter rækken ind som række 3 Selection.Insert Shift:=xlDown Range("A3:F3").Interior.ColorIndex = 6 ' farvelæg rækken Range("B" & OldTarget).Select Else
For Each c In Range("A3:A65000") If Range(c.Address).Interior.ColorIndex <> 6 Then FlytNed = c.Row Exit For End If Next Range("A" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = xlNone Rows(Target.Row).Select Selection.Cut Rows(FlytNed & ":" & FlytNed).Select Selection.Insert Shift:=xlDown Range("B" & OldTarget).Select End If End If Slut: Application.EnableEvents = True End Sub
Synes godt om
Slettet bruger
23. marts 2004 - 09:05#7
Tak for hjælpen Kabbak!
Synes godt om
Slettet bruger
01. april 2004 - 09:44#8
Hej Kabbak
Det har faktisk kunne lade sig gøre at række flytter tilbage til sin "oprindelig" plads. Vi har her i firmaet en der også har rigtigt godt styr på det med Excel og Makroer. Så her er lige den endelig kode!
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3:B65000")) Is Nothing Then On Error GoTo Slut Application.EnableEvents = False If UCase(Target) = "F" Or UCase(Target) = "A" Or UCase(Target) = "F,A" Then OldTarget = Target.Row If OldTarget = 3 Then Range("A" & Target.Row & ":D" & Target.Row).Interior.ColorIndex = 6 Target = UCase(Target) GoTo Slut End If Target = UCase(Target) Rows(Target.Row).Select Selection.Cut Rows("3:3").Select ' sætter rækken ind som række 3 Selection.Insert Shift:=xlDown Range("A3:D3").Interior.ColorIndex = 6 ' farvelæg rækken Range("B" & OldTarget).Select Else
For Each c In Range("A3:A65000") If Range(c.Address).Interior.ColorIndex <> 6 Then FlytNed = c.Row Exit For End If Next Range("A" & Target.Row & ":D" & Target.Row).Interior.ColorIndex = xlNone Rows(Target.Row).Select Selection.Cut Rows(FlytNed & ":" & FlytNed).Select Selection.Insert Shift:=xlDown Range("B" & OldTarget).Select End If End If Slut: Cells.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom Range("a1").Select Application.EnableEvents = True End Sub
ok, det er da godt at i kunne få det til at virke,jeg kan se at i sortere dataerne, var det det der skulle til. ?
Synes godt om
Ny brugerNybegynder
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.
