Spuštění makra při změně hodnoty v buňce Vyřešeno

[Reno70]

Ahoj.
mohl by někdo poradit?

Při změně hodnoty v buňce se mě mají automaticky spustit makra, a to tak:

když je
hodnota buňky = 0 , spustit Aktualizace0
hodnota buňky = 1 , spustit Aktualizace1
hodnota buňky = 2 , spustit Aktualizace2
hodnota buňky = 3 , spustit Aktualizace3

Základní makro, které se spouští při změně hodnoty buňky je následující a sem to potřebuji zapasovat:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' Tato buňka nebo oblast když se změní, spouští se makro
Set KeyCells = Range("F11")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

' Následující makro se změnou buňky nebo oblasti spouští
Aktualizace0

End If
End Sub


Díky moc

[Reklama]

[cmuch]

Ahoj, třeba takto

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim KeyCells As Range

  ' Tato buňka nebo oblast když se změní, spouští se makro
  Set KeyCells = Range("F11")

  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then

    Select Case Target.Value
      Case 0: Aktualizace0
      Case 1: Aktualizace1
      Case 2: Aktualizace2
      Case 3: Aktualizace3
    End Select
  End If
End Sub

[Reno70]

Nádhera, moc děkuji.

Jestli mohu ještě poprosit, potřeboval bych to ještě doplnit o funkčnost v jiných listech a to asi takto:

změním hodnotu na listě A a toto samé provede i na listě B, C, D ...atd.

zkoušel jsem to tak, že sem jednoduše dal vzorec do buňky F11 na listě B, hodnota v listě B se změnila, ale makro se neprovedlo, protože toto on nebere jako změnu v buňce.

[cmuch]

Nevím zda jsem správně pochopil

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Nazvy, KeyCells As Range, i As Byte
 
  'Sem vepsat nazvy listu kterych se tyka
  Nazvy = Array(ActiveSheet.Name, "B", "C", "D")
  ' Tato buňka nebo oblast když se změní, spouští se makro
  Set KeyCells = Range("F11")

  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then

    For i = LBound(Nazvy) To UBound(Nazvy)
      With Worksheets(Nazvy(i))
        .Activate 'aktivace listu
        Select Case .Range(KeyCells.Address).Value
          Case 0: Aktualizace0
          Case 1: Aktualizace1
          Case 2: Aktualizace2
          Case 3: Aktualizace3
        End Select
      End With
    Next i
    Worksheets(Nazvy(0)).Activate 'activace puvodniho listu
  End If
End Sub

[Reno70]

Děkuji, ale neprovádí co má.

změním buňku na listě A, ale na listě B, C, D atd. se změna neprovede a stále tam zůstává původní hodnota.
Listy mají stejnou strukturu, tedy buňka F11 je vždy shodné pole, které potřebuji u všech změnit.

Taky jsem to zkoušel tak, že do prvního listu jsem při změně buňky přidal další makro, tedy takto:
Select Case Target.Value
Case 0: Kopy_F11 ' Nakopíruje hodnotu z buňky do dalších listů
Case 1: Aktualizace0
Case 2: Aktualizace1
Case 3: Aktualizace2
Case 4: Aktualizace3

ale také to nefunguje.

Dodatečně přidáno po 13 minutách 21 vteřinách:
Zkusil jsem ještě něco a to, že sem na hlavní, první list, kde buňku měním výše uvedené upravil a funguje to, i když uživatel to hodně vidí. škoda, že to neběží nenápadně v pozadí.

Select Case Target.Value

Case 0: Kopy_F11
Case 0: Aktualizace0
Case 1: Kopy_F11
Case 1: Aktualizace1
Case 2: Kopy_F11
Case 2: Aktualizace2
Case 3: Kopy_F11
Case 3: Aktualizace3

Nevím zda je to košér a tak jestli máte něco lepšího předem děkuji.

[cmuch]

Tak teď už tomu rozumím

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Nazvy, KeyCells As Range, i As Byte
 
  'Sem vepsat nazvy listu kterych se tyka
  Nazvy = Array(ActiveSheet.Name, "B", "C", "D")
  ' Tato buňka nebo oblast když se změní, spouští se makro
  Set KeyCells = Range("F11")

  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
   
    With Application
      .EnableEvents = False
      .ScreenUpdating = False
   
      For i = LBound(Nazvy) To UBound(Nazvy)
        With Worksheets(Nazvy(i))
          .Activate 'aktivace listu
          .Range(KeyCells.Address).Value = KeyCells.Value
          Select Case .Range(KeyCells.Address).Value
            Case 0: Aktualizace0
            Case 1: Aktualizace1
            Case 2: Aktualizace2
            Case 3: Aktualizace3
          End Select
        End With
      Next i
      Worksheets(Nazvy(0)).Activate 'activace puvodniho listu
     
      .EnableEvents = True
      .ScreenUpdating = True
    End With
  End If
End Sub


[Reno70]

Nádhera a moc děkuji.
Vše funguje jak má.

Děkuji moc a přeji pěkný den

Téma uzamykám.