< návrat zpět

MS Excel

Téma: MsgBox z více hodnot rss

Zaslal/a Dita 5.1.2021 8:45

Dobrý den
Prosím o radu. V souboru mám nasimulováno při otevření sešitu, aby se zobrazovala zpráva, že ta a ta směna má plné obsazení šichet. Jenže to mám tak, že se zobrazí zpráva za každý měsíc a každou šichtu zvlášť. Bylo by možné, aby se pro každou šichtu (Směna A, Směna B) zobrazila jenom jedna zpráva, ve které by byly vypsány ty měsíce s plnými šichtami?
Díky

Příloha: rar49349_pokus_oznameni.rar (14kB, staženo 18x)
Zaslat odpověď >
Dita(6.1.2021 12:51)citovat#049368
avatar
Tak jsem to trochu pořešil. Nezdá se mi to zrovna košér, ale funguje to. Když nebude mít "Směna A" žádnou plnou šichtu (C1, C4, C7, C10 = 0) tak se MsgBox nespustí. To je OK. Jakmile se změní jedna z těchto hodnot, tak se MSgBox spustí a vypíše VŠECHNY měsíce a u každého kolik směn je plných, popř., když nemá žádnou, že je to v pořádku. Představoval bych si ale, když už se MsgBox spustí, aby vypsal jenom měsíce ve kterém je nějaká plná šichta. S tím si nevím rady.
Děkuji za radu.
Příloha: rar49368_pokus_oznameni-leden-duben.rar (15kB, staženo 16x)
Milan-158(6.1.2021 13:41)citovat#049369
avatar
Zde inspirace jak to dělat "košér". Snad si to upravíš dle sebe:
Dim strA As String, strB As String
Dim i As Integer, iMax As Integer
Dim ws As Worksheet

ThisWorkbook.Activate
Set ws = Worksheets("List1")

'poslední řádek:
iMax = Application.Max(ws.Range("A65000").End(xlUp).Row, ws.Range("B65000").End(xlUp).Row, ws.Range("C65000").End(xlUp).Row)

'vyskládej text za směnu A
strA = "Směna A:" & vbCrLf
For i = 1 To iMax Step 3
strA = strA & vbTab & ws.Cells(i, "A") & vbTab & ws.Cells(i, "D") & vbCrLf
Next i

'vyskládej text za směnu B
strB = "Směna B:" & vbCrLf
For i = 2 To iMax Step 3
strB = strB & vbTab & ws.Cells(i - 1, "A") & vbTab & ws.Cells(i, "D") & vbCrLf
Next i
MsgBox Prompt:=strA & vbCrLf & strB, Buttons:=vbOK, Title:="Přehled plných směn"
Dita(6.1.2021 14:52)citovat#049370
avatar
@Milan-158 to je jiná. Ale jsou 4 směny a to bude box docela dlouhej (vysokej). Proto jsem myslel, že by se vypsaly pouze měsíce, kdy jsou plné šichty. To by se hodně zkrátil. Ve skutečnosti jich moc nebude. Mělo by to být upozornění pro vedoucí směn, aby si ty plné šichty rozplánovaly. V ideálním stavu by MsgBox neměl vůbec zobrazit, což se ale nestává.
I tak díky.
Milan-158(6.1.2021 16:08)citovat#049371
avatar
No tak konečně známe pravý účel makra, který byl na počátku jen mlhavě naznačený.
Tomu by pak odpovídalo i řešení.

No nic ...
Dita(6.1.2021 17:19)citovat#049372
avatar
Nebyl v tom žádný úmysl 1
elninoslov(6.1.2021 18:03)citovat#049373
elninoslov
Private Sub Workbook_Open()
Dim R As Long, D(), V() As String, SA As String, SB As String

With ThisWorkbook.Worksheets("List1")
R = .Cells(Rows.Count, "B").End(xlUp).Row
D = .Cells(1, 1).Resize(R, 3).Value
End With
ReDim V(UBound(D, 1) - 1)

For R = 1 To R
If D(R, 3) > 0 Then V(R - 1) = D(R, 2) & D(((R - 1) \ 3) * 3 + 1, 1) & " - " & D(R, 3) & IIf(D(R, 3) = 1, " plná směna", IIf(D(R, 3) < 5, " plné směny", " plných směn"))
Next R

SA = Replace(Join(Filter(V, "Směna A", True), vbCrLf), "Směna A", "")
If SA <> "" Then SA = "Směna A" & vbCrLf & vbCrLf & SA

SB = Replace(Join(Filter(V, "Směna B", True), vbCrLf), "Směna B", "")
If SB <> "" Then SA = IIf(SA = "", "", SA & vbCrLf & vbCrLf) & "Směna B" & vbCrLf & vbCrLf & SB

If SA <> "" Then MsgBox SA, vbExclamation, "Přehled plných směn."
End Sub

Pozerám u kolegu vyššie - dobrý nápad s tými Tabulátormi. Úprava s nimi:
Private Sub Workbook_Open()
Dim R As Long, D(), V() As String, SA As String, SB As String

With ThisWorkbook.Worksheets("List1")
R = .Cells(Rows.Count, "B").End(xlUp).Row
D = .Cells(1, 1).Resize(R, 3).Value
End With
ReDim V(UBound(D, 1) - 1)

For R = 1 To R
If D(R, 3) > 0 Then V(R - 1) = vbTab & D(R, 2) & D(((R - 1) \ 3) * 3 + 1, 1) & vbTab & D(R, 3) & IIf(D(R, 3) = 1, " plná směna", IIf(D(R, 3) < 5, " plné směny", " plných směn"))
Next R

SA = Replace(Join(Filter(V, "Směna A", True), vbCrLf), "Směna A", "")
If SA <> "" Then SA = "Směna A :" & vbCrLf & SA

SB = Replace(Join(Filter(V, "Směna B", True), vbCrLf), "Směna B", "")
If SB <> "" Then SA = IIf(SA = "", "", SA & vbCrLf & vbCrLf) & "Směna B :" & vbCrLf & SB

If SA <> "" Then MsgBox SA, vbExclamation, "Přehled plných směn."
End Sub
Dita(6.1.2021 18:34)citovat#049375
avatar
@elninoslov tak takto jsem si to představoval 1 . Teď jestli to napasuju do mého sešitu 4 . A už vůbec nechápu, jak to někdo vymyslí 7
Díky
Dita(9.1.2021 21:15)citovat#049419
avatar
@elninoslov, můžu požádat o úpravu pro 4 směny? Já se v tom plácám a furt mi to nefunguje, tak jak by mělo. Je to vlastně pokus-omyl 7
Děkuji předem 4
Příloha: rar49419_pokus_oznameni_2.rar (19kB, staženo 15x)
elninoslov(9.1.2021 22:51)citovat#049420
elninoslov
Prerobil som to na jednoduché parametrizovanie. Na začiatku vidíte 3 riadiace premenné. Význam je jasný. Urobil som aký-taký popis makra.
Ak zadáte parametre 4, 4, AS, funguje na novú tbl.
Ak zadáte 2, 3, A funguje na starú tbl.

Private Sub Workbook_Open()
Dim R As Long, D(), V() As String, S As String, Sprava As String, Smeny(), PocetSmen As Byte, SloupecMesice As String, Skok As Byte

PocetSmen = 4 'Počet směn
Skok = 4 'Počet řádků na měsíc
SloupecMesice = "AS" 'Sloupec s názvem měsíce

With ThisWorkbook.Worksheets("List1")
R = .Cells(Rows.Count, SloupecMesice).Offset(0, 1).End(xlUp).Row 'Počet řádků dat se určí ze sloupce vpravo od sloupce měsíců
D = .Cells(1, SloupecMesice).Resize(R, 3).Value 'Načíst 3 sloupce dat
Smeny = .Cells(1, SloupecMesice).Offset(0, 1).Resize(PocetSmen).Value 'Názvy směn se berou z prvního měsíce
End With
ReDim V(UBound(D, 1) - 1) 'Príprava výsledkového pole

For R = 1 To R 'Projdi všechny řádky dat, jestli jsou plné, podle skoku zjisti název mesíce pro danou N-tici, a vyskloňuj
If D(R, 3) > 0 Then V(R - 1) = vbTab & D(R, 2) & D(((R - 1) \ Skok) * Skok + 1, 1) & vbTab & D(R, 3) & IIf(D(R, 3) = 1, " plná směna", IIf(D(R, 3) < 5, " plné směny", " plných směn"))
Next R

For R = 1 To PocetSmen 'Opakuj filtr na výsledkové pole pro každou směnu
S = Replace(Join(Filter(V, Smeny(R, 1), True), vbCrLf), Smeny(R, 1), "") 'Vyfiltruje výsledek na danou směnu, vymaže její název
If LenB(S) > 0 Then Sprava = Sprava & IIf(LenB(Sprava) = 0, "", vbCrLf & vbCrLf) & Smeny(R, 1) & ":" & vbCrLf & S 'Když něco zústane, přidá to k předešlé správě
Next R

If Sprava <> "" Then MsgBox Sprava, vbExclamation, "Přehled plných směn." 'Když máme nějakou komplexní správu, tak ji vypiš
End Sub
Příloha: zip49420_pokus_oznameni_2.zip (18kB, staženo 16x)
Dita(10.1.2021 8:19)citovat#049421
avatar
@elninoslov děkuji velice za ochotu.

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje