Excel - VBA - vyskakovací okno

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

Moderátor: Mods_senior

oximoxi
nováček
Příspěvky: 24
Registrován: leden 12
Pohlaví: Muž

Excel - VBA - vyskakovací okno

Příspěvekod oximoxi » 03 lis 2017 14:14

Zdravím,
potřeboval bych, aby mi excel vyhodil okno s hláškou při splnění podmínky, že buňka na určitém řádku ve sloupci L je vyplněna a současně buňka ve sloupci K na témže řádku je prázdná.Tento skript mi funguje tak jak má, ale pouze na jeden řádek. Jak provedu totéž se všemi řádky v sešitu? Díky.

Sub IsEmptyExample1()

If IsEmpty(Cells(3, 12)) = False Then
If IsEmpty(Cells(3, 11)) = True Then

MsgBox "Doplňte jméno.", vbOKOnly + vbExclamation, "Jméno pracovníka"

End If
End If

End Sub



Reklama
Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 176
Registrován: červen 13
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod elninoslov » 03 lis 2017 15:36

Nedostatočné informácie. Ako voláte túto procedúru ? Pri akej príležitosti ? Nejakým tlačítkom hromadne ? Pri každej zmene bunky ? Ak pri každej zmene bunky, tak ktorej oblasti sa to má týkať ? Atď...
A treba použiť v IF operátor AND alebo OR (podľa potreby) a nie 2x IF.
Dajte prílohu s lepším vysvetlením.

oximoxi
nováček
Příspěvky: 24
Registrován: leden 12
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod oximoxi » 06 lis 2017 10:31

Při změně buňky ve sloupci L, přičemž by se to mělo týkat řádků 3 až nekonečno.
Jestliže je na X-tém řádku vyplněna buňka ve sloupci L, buňka ve sloupci K nesmí zůstat prázdná, jinak MsgBox...

Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 176
Registrován: červen 13
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod elninoslov » 06 lis 2017 13:37

Tam môže nastať množstvo variantov.
-vyplnené K nevyplnené L
-opačne
-obe vyplnené
-vymazané K ale L ponechané
-opačne
-kopírovanie viacriadkovej oblasti (aj vyplnené aj nevyplnené)
-mazanie viacriadkovej oblasti
-mazanie viacriadkovej nesúvislej oblasti
-... a ich kombinácie
-upozorňovanie na všetky riadky, nie len na jeden

Toto by sa malo vysporiadať asi so všetkým čo ma napadlo, a dosť rýchlo:

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, ARE As Range, D(), AR As Long, R As Long, RC As Long, Sprava As String

  Set Zmena = Intersect(Target, Columns(12).Resize(Rows.Count - 2).Offset(2))
  If Not Zmena Is Nothing Then
   
    For Each ARE In Zmena.Areas
      With ARE
      AR = .Rows.Count
      RC = .Row - 1
      D = .Offset(0, -1).Resize(AR, 2).Value2
        For R = 1 To AR
          If D(R, 2) <> "" And D(R, 1) = "" Then
          Sprava = Sprava & IIf(Sprava = "", "", vbNewLine) & "v buňce K" & RC + R & " k hodnotě " & D(R, 2)
          End If
        Next R
      End With
    Next ARE
   
    If Sprava <> "" Then MsgBox "Doplňte jméno :" & vbNewLine & Sprava, vbOKOnly + vbExclamation, "Jméno pracovníka"
    Set Zmena = Nothing: Set ARE = Nothing
  End If
End Sub


Aj tak je ale množstvo úskalí.
-čo ak sa vymaže bunka/bunky v K a v L sú pritom dáta ? Žiadne upozornenie nedostanete.
-čo ak sa po upozornení neurobí náprava (zadanie dát) ? ďalší krát už sa nevyplnená bunka v K nebude kontrolovať, pretože je L vyplnené a tým pádom už v L nenastane zmena a nevyvolá sa makro.

Podľa mňa by bolo lepšie to zdupľovať vyfarbením buniek pomocou PF. Alebo použiť iba PF. Tiež ukázané v súbore.
Nemáte oprávnění prohlížet přiložené soubory.

oximoxi
nováček
Příspěvky: 24
Registrován: leden 12
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod oximoxi » 07 lis 2017 08:49

Díky za zaslaný skript :) Samozřejmě více možností nastat může, nicméně vzhledem k plánovanému užití je nepředpokládám.
Tento skript funguje, nicméně potřeboval bych provést ještě jednu drobnou úpravu, se kterou si nevím rady. Do zprávy vyskakovacího okna bych potřeboval uvést nikoliv označení buňky K a hodnotu v buňce L, ale číslo zápisu, které je vždy ve sloupci A na daném řádku. Tedy: "Doplňte jméno pracovníka k zápisu č. [hodnota buňky A]

Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 176
Registrován: červen 13
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod elninoslov » 07 lis 2017 09:05

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, ARE As Range, D(), A(), AR As Long, R As Long, RC As Long, Sprava As String

  Set Zmena = Intersect(Target, Columns(12).Resize(Rows.Count - 2).Offset(2))
  If Not Zmena Is Nothing Then
   
    For Each ARE In Zmena.Areas
      With ARE
        AR = .Rows.Count
        RC = .Row - 1
        D = .Offset(0, -1).Resize(AR, 2).Value2
        ReDim A(1 To AR, 1 To 1)
        If AR = 1 Then A(1, 1) = .Offset(0, -11).Value2 Else A = .Offset(0, -11).Value2
        For R = 1 To AR
          If D(R, 2) <> "" And D(R, 1) = "" Then
          Sprava = Sprava & IIf(Sprava = "", "", vbNewLine) & "číslo zápisu " & A(R, 1)
          End If
        Next R
      End With
    Next ARE
   
    If Sprava <> "" Then MsgBox "Doplňte jméno pracovníka k zápisu č. :" & vbNewLine & Sprava, vbOKOnly + vbExclamation, "Jméno pracovníka"
    Set Zmena = Nothing: Set ARE = Nothing
  End If
End Sub

oximoxi
nováček
Příspěvky: 24
Registrován: leden 12
Pohlaví: Muž

Re: Excel - VBA - vyskakovací okno

Příspěvekod oximoxi » 07 lis 2017 09:08

Paráda, mnohokrát děkuji. :)


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Excel VBA - GetObject
    od Grimm » 11 bře 2019 14:53 » v Kancelářské balíky
    3
    358
    od ITCrowd
    11 bře 2019 16:12
  • Excel - VBA - Makro - odeslání dat ze souboru A do souboru B
    od Pavel Křivánek » 26 lis 2018 15:04 » v Kancelářské balíky
    3
    784
    od MePExG
    28 lis 2018 21:30
  • Namátkou vyskakující okno
    od Fanous18 » 13 říj 2018 14:19 » v Vše ostatní (sw)
    1
    449
    od xbs
    13 říj 2018 17:51
  • VBA formatovanievanie
    od tsibee » 09 led 2019 11:18 » v Kancelářské balíky
    1
    408
    od atari
    09 led 2019 12:13
  • skorektnenie riadku VBA
    od tsibee » 04 čer 2018 13:58 » v Kancelářské balíky
    14
    1102
    od tsibee
    08 čer 2018 13:32

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

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 0 hostů