køre en makro i en linie alt efter hvad der står i kolonne D

Prøv dette:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D1:D30")) Is Nothing Then


Select Case Target.Offset(0, 0).Value

Case 1
  MsgBox ("call makro1")
Case 2
  MsgBox ("call makro2")
Case Else
  MsgBox ("call andet")
End Select

End If
End Sub

prøv denne

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
    On Error Resume Next
        Application.Run "Makro" & Target
    End If
End Sub

D1:D30 er det område hvor den skal kigge på ændringer

og istedet for msgbox skal du selvfølgelige kalde din makro

makroer se sådan ud...

Sub makro1()
    Selection.RowHeight = 20
End Sub

Sub makro2()
    Selection.RowHeight = 40
End Sub

Sub makro3()
    Selection.RowHeight = 60
End Sub

Når jeg bruger ovenstående løsninger laver den en sjov fejl.

hvis jeg skriver 3 i d10 og trykker ENTER
så formaterer den linie 11 med makro 3 og ikke linie 10, som jeg har indtastet i.

hvis jeg skriver 3 i d10 og trykker TAB
så formaterer den linie 10 med makro 3, som den skal.

Jeg ville gøre sådan (Indsættes i arkets kodemodul):

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
If Target = 1 Then Target.RowHeight = 20
If Target = 2 Then Target.RowHeight = 40
If Target = 3 Then Target.RowHeight = 60
End Sub

og så slette alle de øvrige makroer

i arkets kodemodul

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
  ' On Error Resume Next
        Application.Run "Makro" & Target, Target.Address
    End If
End Sub

i et modul

Sub makro1(ad)
    Range(ad).RowHeight = 20
End Sub

Sub makro2(ad)
    Range(ad).RowHeight = 40
End Sub

Sub makro3(ad)
    Range(ad).RowHeight = 60
End Sub

jeg har forsøgt begge løsningsforslag.
Jeg kan ikke få kabbaks til at virke. Det er som om af makroerne ikke vises når de f.eks. hedder:

makro1(ad)

Jeg kan sagtens få excelents forslag til at virke og det er nok den der passer bedst til mit problem. Jeg tror at jeg fik gjort problemet større i mit sprøgsmål end det egentligt var.

Hvis vi nu siger at jeg vælger excelents forslag.
kan man så få den til at "køre" makroen automatisk på alle linier i arket.
Hvis der ikke står noget i kolonne D skal den bolt lade linie være som den allerede er.

Hvis der ikke står noget i kolonne D skal den blot lade linien være som den allerede er, og ikke ændre på højden :-)

Sorry, man er lidt fummelfingret

Prøv denne her, det kræver blot at der altid står et tal i kolonne D, idet kolonne D køres igennem til første tomme celle.

Private Sub Worksheet_Change(ByVal Target As Range)
  Const D = "D"
  Dim sAktiveCelle As String
  Dim iCelle As Integer
  Dim bVærdi As Byte
 
    sAktiveCelle = ActiveCell.Address
 
    Range("D1").Select
    iCelle = ActiveCell.Row

  Do
    iCelle = iCelle + 1
    Range(D & iCelle).Select
    bVærdi = ActiveCell.Value
   
    If bVærdi = 1 Then
      Selection.RowHeight = 10
    ElseIf bVærdi = 2 Then
      Selection.RowHeight = 20
    ElseIf bVærdi = 3 Then
      Selection.RowHeight = 30
    ElseIf bVærdi = 4 Then
      Selection.RowHeight = 40
    ElseIf bVærdi = 5 Then
      Selection.RowHeight = 50
    ElseIf bVærdi = 6 Then
      Selection.RowHeight = 60
    ElseIf bVærdi = 7 Then
      Selection.RowHeight = 70
    ElseIf bVærdi = 8 Then
      Selection.RowHeight = 80
    ElseIf bVærdi = 9 Then
      Selection.RowHeight = 90
    ElseIf bVærdi = 10 Then
      Selection.RowHeight = 100
    End If
  Loop Until ActiveCell.Value = ""

    Range(sAktiveCelle).Select

End Sub

Min virker på alle linier, men kun i kolonne D
Skal den virke i alle kolonner ?

den excelent har lavet virker lige som den skal.
Den ændrer den linie som man står, når man retter f.eks. d10.

Det er super. men jeg mangler lige en ekstra variant, som skal bruges på andre tidspunkter.

Denne skal gøre det samme, men den skal gøre det på ALLE linier i intervallet 2-100

Denne makro har altså ikke noget med den første at gøre.
Den kunne evt. hedde.

SUB ændreallelinjer

Bemærk at det ikke er ALTID der er et tal i kolonne D.
der kan være tallet 1 til 5 (eller tom) i kolonne D.

Den skal kigge i linje d2 og se hvilket tal der står. Formatere linjen udfra det tal der står og gå videre til linje 3. o.s.v.

Selvom kolonne D er tom i en linie skal den fortsætte til den næste linje.
Gerne i intervallet 2-100.

skal jeg oprette et nyt spg. til dette?

prøv:

Sub CheckD()
For t = 2 To 100
If Cells(t, "D") = 1 Then Cells(t, "D").RowHeight = 20
If Cells(t, "D") = 2 Then Cells(t, "D").RowHeight = 40
If Cells(t, "D") = 3 Then Cells(t, "D").RowHeight = 60
If Cells(t, "D") = 4 Then Cells(t, "D").RowHeight = 80
If Cells(t, "D") = 5 Then Cells(t, "D").RowHeight = 100
Next
End Sub

Hej!
Hvis du mangler en makro der kan gøre det på alle linier i interval på 2-200 kan du skifte do loop løkke koden i det forslag jeg tidligere har vist dig, til denne her løkke:

For i = 1 To 200
    iCelle = iCelle + 1
    Range(D & iCelle).Select
    bVærdi = ActiveCell.Value
   
    If bVærdi = 1 Then
      Selection.RowHeight = 10
    ElseIf bVærdi = 2 Then
      Selection.RowHeight = 20
    ElseIf bVærdi = 3 Then
      Selection.RowHeight = 30
    ElseIf bVærdi = 4 Then
      Selection.RowHeight = 40
    ElseIf bVærdi = 5 Then
      Selection.RowHeight = 50
    ElseIf bVærdi = 6 Then
      Selection.RowHeight = 60
    ElseIf bVærdi = 7 Then
      Selection.RowHeight = 70
    ElseIf bVærdi = 8 Then
      Selection.RowHeight = 80
    ElseIf bVærdi = 9 Then
      Selection.RowHeight = 90
    ElseIf bVærdi = 10 Then
      Selection.RowHeight = 100
    End If
  Next i

Hej !
For god ordnens skyld:
Den første kode jeg skrev til dig med løkkekoden Do loop, og den næste rettelse med For i - Next koden, vær opmærksom på at hele koden eksekveres hver gang der er foretaget en indtastning eller rettelse et hvilket som helst sted i dit Excelark, men koden løber kun kolonne D igennem.

så blev det endelig weekend og tid til at lege lidt med excel igen
Jeg beklager at jeg iukke er vendt tilbage før nu.

både excelent og svla´s løsninger virker.
jeg er lidt træt af at skulle dele 60 points imellem jer.

Så hvis en af jer svarer på dette spørgsmål, så opretter jeg et nyt spørgsmål til den anden, som så også kan høste 60 points.

Der var jo faktisk også 2 spørgsmål i dette....

Hvad siger I til det?

fint med mig :-)

Hej
Jeg går ikke så meget op i og tjene point, men læser og svarer kun af interesse indenfor Excel og VBA, for mig er det ok hvis du giver alle point til excelent.

så fik excelent alle pointene.
tak for indsatsen