Søg
Avatar billede thomasmyg Nybegynder
06. april 2012 - 12:50 Der er 16 kommentarer og
1 løsning

VBA med makro script til virke på flere rækker

Jeg har fået lavet følgende VBA script:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("$A$1")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$B$1").Value = Range("$A$1").Value / 2
Range("$C$1").Value = Range("$A$1").Value / 4
Range("$D$1").Value = Range("$A$1").Value / 12

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$B$1")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A$1").Value = Range("$B$1").Value * 2
Range("$C$1").Value = Range("$B$1").Value / 2
Range("$D$1").Value = Range("$B$1").Value / 6

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$C$1")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A$1").Value = Range("$C$1").Value * 4
Range("$B$1").Value = Range("$A$1").Value / 2
Range("$D$1").Value = Range("$C$1").Value / 3

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$D$1")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A$1").Value = Range("$D$1").Value * 12
Range("$B$1").Value = Range("$D$1").Value * 6
Range("$C$1").Value = Range("$D$1").Value * 3

Application.EnableEvents = True 'Events aktiveres igen

End If

End Sub

Men jeg kan ikke finde ud af hvordan jeg skal få det til at virke på flere rækker uden at skulle det skal fylde ufattelig mange linjer.
Avatar billede store-morten Ekspert
06. april 2012 - 13:38 #1
Måske (Række 1 til 5):
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("$A1:A5")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
Range("$C" & Target.Row).Value = Range("$A" & Target.Row).Value / 4
Range("$D" & Target.Row).Value = Range("$A" & Target.Row).Value / 12

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$B1:B5")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$B" & Target.Row).Value * 2
Range("$C" & Target.Row).Value = Range("$B" & Target.Row).Value / 2
Range("$D" & Target.Row).Value = Range("$B" & Target.Row).Value / 6

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$C1:C5")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$C" & Target.Row).Value * 4
Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
Range("$D" & Target.Row).Value = Range("$C" & Target.Row).Value / 3

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$D1:D5")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$D" & Target.Row).Value * 12
Range("$B" & Target.Row).Value = Range("$D" & Target.Row).Value * 6
Range("$C" & Target.Row).Value = Range("$D" & Target.Row).Value * 3

Application.EnableEvents = True 'Events aktiveres igen

End If

End Sub
Avatar billede store-morten Ekspert
06. april 2012 - 14:00 #2
Er det specifikker rækker så

Reagerer kun på: A1, A3 og A5:
If Not Intersect(Target, Range("$A$1, $A$3, $A$5")) Is Nothing Then

Og husk at rette for B, C og D.
Avatar billede thomasmyg Nybegynder
06. april 2012 - 14:00 #3
Jeg tænkte mere på at man have en linje i koden hvor man kunne tilføje rækkerne fx 1, 2, 3, 4, 8, 9, 11 osv?
Avatar billede store-morten Ekspert
06. april 2012 - 14:02 #4
ja
Avatar billede store-morten Ekspert
06. april 2012 - 14:06 #5
If Not Intersect(Target, Range("$A$1, $A$2, $A$3, $A$4, $A8, $A$9, $A$11")) Is Nothing Then
Osv...
Avatar billede thomasmyg Nybegynder
06. april 2012 - 14:11 #6
Ja men det skal jeg så rette for alle 4 linjer, kan man ikke lave koden så det altid gælder for A, B, C og D, og skal man have flere rækker med så kan man bare tilføje dem?
Avatar billede store-morten Ekspert
06. april 2012 - 14:24 #7
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("$A$1, $A$2, $A$3, $A$4, $A8, $A$9, $A$11")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
Range("$C" & Target.Row).Value = Range("$A" & Target.Row).Value / 4
Range("$D" & Target.Row).Value = Range("$A" & Target.Row).Value / 12

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$B$1, $B$2, $B$3, $B$4, $B8, $B$9, $B$11")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$B" & Target.Row).Value * 2
Range("$C" & Target.Row).Value = Range("$B" & Target.Row).Value / 2
Range("$D" & Target.Row).Value = Range("$B" & Target.Row).Value / 6

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$C$1, $C$2, $C$3, $C$4, $C8, $C$9, $C$11")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$C" & Target.Row).Value * 4
Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
Range("$D" & Target.Row).Value = Range("$C" & Target.Row).Value / 3

Application.EnableEvents = True 'Events aktiveres igen

End If

If Not Intersect(Target, Range("$D$1, $D$2, $D$3, $D$4, $D$8, $D$9, $D$11")) Is Nothing Then

Application.EnableEvents = False 'For at undgå at koden looper

Range("$A" & Target.Row).Value = Range("$D" & Target.Row).Value * 12
Range("$B" & Target.Row).Value = Range("$D" & Target.Row).Value * 6
Range("$C" & Target.Row).Value = Range("$D" & Target.Row).Value * 3

Application.EnableEvents = True 'Events aktiveres igen

End If

End Sub
Avatar billede thomasmyg Nybegynder
06. april 2012 - 14:33 #8
Ja det er jeg med på, tror ikke du forstår hvad jeg mener.

Kan man ikke have 2 Worksheet_change til samme dokument?
Avatar billede store-morten Ekspert
06. april 2012 - 14:36 #9
Kan man ikke have 2 Worksheet_change til samme dokument?

Nej
Avatar billede thomasmyg Nybegynder
06. april 2012 - 14:43 #10
Nej. Okay

Kan man ikke slippe for de 4 linjer her:
If Not Intersect(Target, Range("$A$1, $A$2, $A$3, $A$4, $A8, $A$9, $A$11")) Is Nothing Then

If Not Intersect(Target, Range("$B$1, $B$2, $B$3, $B$4, $B8, $B$9, $B$11")) Is Nothing Then

If Not Intersect(Target, Range("$C$1, $C$2, $C$3, $C$4, $C8, $C$9, $C$11")) Is Nothing Then

If Not Intersect(Target, Range("$D$1, $D$2, $D$3, $D$4, $D$8, $D$9, $D$11")) Is Nothing Then

og så have en linje i toppen hvor man skriver de rækker ind man gerne vil havd det skal gælde for?
Avatar billede store-morten Ekspert
06. april 2012 - 15:23 #11
Kan du leve med en ekstra kolonne med x for beregning?
Avatar billede thomasmyg Nybegynder
06. april 2012 - 15:26 #12
Det vil jeg helst gerne undgå.
Avatar billede store-morten Ekspert
06. april 2012 - 15:29 #13
Men her er et bud, hvor den beregner hvis der er et "x" i kolonne E:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Range("$E" & Target.Row).Value = "x" Then
    Application.EnableEvents = False 'For at undgå at koden looper
        Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
        Range("$C" & Target.Row).Value = Range("$A" & Target.Row).Value / 4
        Range("$D" & Target.Row).Value = Range("$A" & Target.Row).Value / 12
    Application.EnableEvents = True 'Events aktiveres igen
End If
End If

If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Range("$E" & Target.Row).Value = "x" Then
    Application.EnableEvents = False 'For at undgå at koden looper
        Range("$A" & Target.Row).Value = Range("$B" & Target.Row).Value * 2
        Range("$C" & Target.Row).Value = Range("$B" & Target.Row).Value / 2
        Range("$D" & Target.Row).Value = Range("$B" & Target.Row).Value / 6
    Application.EnableEvents = True 'Events aktiveres igen
End If
End If

If Not Intersect(Target, Range("C:C")) Is Nothing Then
If Range("$E" & Target.Row).Value = "x" Then
    Application.EnableEvents = False 'For at undgå at koden looper
        Range("$A" & Target.Row).Value = Range("$C" & Target.Row).Value * 4
        Range("$B" & Target.Row).Value = Range("$A" & Target.Row).Value / 2
        Range("$D" & Target.Row).Value = Range("$C" & Target.Row).Value / 3
    Application.EnableEvents = True 'Events aktiveres igen
End If
End If

If Not Intersect(Target, Range("D:D")) Is Nothing Then
If Range("$E" & Target.Row).Value = "x" Then
    Application.EnableEvents = False 'For at undgå at koden looper
        Range("$A" & Target.Row).Value = Range("$D" & Target.Row).Value * 12
        Range("$B" & Target.Row).Value = Range("$D" & Target.Row).Value * 6
        Range("$C" & Target.Row).Value = Range("$D" & Target.Row).Value * 3
    Application.EnableEvents = True 'Events aktiveres igen
End If
End If

End Sub
Avatar billede store-morten Ekspert
06. april 2012 - 15:30 #14
Kolonne E kan jo Skjules ;-)
Avatar billede store-morten Ekspert
06. april 2012 - 15:36 #15
Eller har du en kolonne, i forvejen, der kan bruges?
En bestemt tekst eller værdi, i rækken.
Avatar billede thomasmyg Nybegynder
06. april 2012 - 15:39 #16
Den løsning er jeg ikke så glad for.

Jeg tror jeg holder mig til dit seneste forslag, det virker godt og gør det jeg gerne vil have, næsten ;).
Vil du ligge et svar, så du kan få pointene.

Ps. der kommer nok et spørgsmål mere fra mig i dag :D
Avatar billede store-morten Ekspert
06. april 2012 - 15:40 #17
Okay.
Avatar billede 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.

Loading billede Opret Preview
Kategori
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
Makro der gemmer vedhæftet fil fra Msg og omdøber filen Af lokesa i Excel 2 31/03/202610:22 31/03/202611:47
Stempel ur start og stop Af lurup i Excel 2 23/03/202613:24 31/03/202610:27
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel 4 08/03/202611:56 08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel 4 04/03/202617:11 06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel 3 19/02/202614:23 20/02/202608:26
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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
35 min siden Messinger virker ikke på Windows 10 og Windows 11 Af eksmojo i Windows
I går 17:32 Jeg kan ikke opdatere min iPad til ios 26.4.1. Af Bettina i Apps til iOS
I går 08:32 Office pakke LTSC vs Retail? Af Don G i Office & Kontorpakker
10/0421:19 Lydindstilling Prosonic TV Af TageArent i Fjernsyn & projektorer
10/0415:37 Sort skærm Af mort1 i Windows
White papers
Flere white papers »