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ž
Stav:
Offline

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.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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ž
Stav:
Offline

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.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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.
Přílohy
Kontrola vyplnenia stĺpca.zip
(14.82 KiB) Staženo 43 x

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

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.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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ž
Stav:
Offline

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 a OneDrive
    od sginfo » 11 zář 2023 15:28 » v Kancelářské balíky
    16
    6000
    od mirekol Zobrazit poslední příspěvek
    20 říj 2023 08:31
  • Excel - vlastní formát Příloha(y)
    od Story-Long » 11 srp 2023 14:50 » v Kancelářské balíky
    3
    1842
    od Story-Long Zobrazit poslední příspěvek
    14 srp 2023 10:11
  • Excel - funkce když
    od Martyn20 » 13 črc 2023 11:56 » v Kancelářské balíky
    5
    2325
    od mmmartin Zobrazit poslední příspěvek
    13 črc 2023 18:44
  • Excel - problém se vzorci
    od honzzicek » 28 čer 2023 21:45 » v Kancelářské balíky
    2
    1644
    od honzzicek Zobrazit poslední příspěvek
    01 črc 2023 08:57
  • excel-posun makra
    od actionboy » 12 bře 2024 18:59 » v Kancelářské balíky
    1
    266
    od Grimm Zobrazit poslední příspěvek
    12 bře 2024 21:43

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 7 hostů