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

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Reno70
nováček
Příspěvky: 7
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

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

Příspěvekod Reno70 » 07 bře 2016 09:11

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
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Spuštění makra při změně hodnoty v buňce

Příspěvekod cmuch » 07 bře 2016 10:30

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
nováček
Příspěvky: 7
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Spuštění makra při změně hodnoty v buňce

Příspěvekod Reno70 » 07 bře 2016 10:51

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
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Spuštění makra při změně hodnoty v buňce

Příspěvekod cmuch » 07 bře 2016 16:39

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
nováček
Příspěvky: 7
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Spuštění makra při změně hodnoty v buňce

Příspěvekod Reno70 » 08 bře 2016 08:15

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
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Spuštění makra při změně hodnoty v buňce

Příspěvekod cmuch » 08 bře 2016 13:10

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
nováček
Příspěvky: 7
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

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

Příspěvekod Reno70 » 08 bře 2016 15:05

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

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

Téma uzamykám.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Problém s připojením na wifi síť při změně PC Příloha(y)
    od Baader » 09 srp 2023 10:38 » v Sítě - hardware
    18
    3028
    od Baader Zobrazit poslední příspěvek
    10 srp 2023 14:16
  • Aktivace Windows po změně disku Příloha(y)
    od JanC » 15 říj 2023 20:32 » v Windows 11, 10, 8...
    24
    3984
    od JanC Zobrazit poslední příspěvek
    08 lis 2023 08:19
  • PowerPoint osekává zvuk při změně snímku
    od Venus » 12 úno 2024 16:35 » v Kancelářské balíky
    2
    1122
    od Venus Zobrazit poslední příspěvek
    13 úno 2024 16:57
  • excel-posun makra
    od actionboy » 12 bře 2024 18:59 » v Kancelářské balíky
    1
    260
    od Grimm Zobrazit poslední příspěvek
    12 bře 2024 21:43
  • Nastavení měřítka obrazovky na jiné, než předdefinované hodnoty Příloha(y)
    od Grander » 29 čer 2023 17:34 » v Windows 11, 10, 8...
    0
    1050
    od Grander Zobrazit poslední příspěvek
    29 čer 2023 17:34

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Majestic-12 [Bot] a 6 hostů