Příspěvky uživatele
< návrat zpět
Prípadne ešte zmeniť SUMIFS na SUMIF, teda prvú položku poľa Array() zmeniť
z
"=SUMIFS(DATA!$B$2:$B$" & PoslRadekD & ",DATA!$A$2:$A$" & PoslRadekD & ",$B5)"
na
"=SUMIF(DATA!$A$2:$A$" & PoslRadekD & ",$B5,DATA!$B$2:$B$" & PoslRadekD & ")"
Teda celý riadok bude:
.Formula = Array("=SUMIF(DATA!$A$2:$A$" & PoslRadekD & ",$B5,DATA!$B$2:$B$" & PoslRadekD & ")", "=VLOOKUP($B5,DATA!$A$2:$B$" & PoslRadekD & ",2,FALSE)", "=COUNTIF(DATA!$A$2:$A$" & PoslRadekD & ",$B5)")
Skúste toto:
Sub MALED()
Dim PoslRadekV As Long, PoslRadekD As Long
PoslRadekD = wsData.Cells(Rows.Count, 1).End(xlUp).Row
If PoslRadekD < 2 Then MsgBox "Žádná data v liste DATA.", vbExclamation, "Chyba": Exit Sub
With wsVypocet
PoslRadekV = .Cells(Rows.Count, 2).End(xlUp).Row
If PoslRadekV < 5 Then MsgBox "Žádná data v liste VÝPOČET.", vbExclamation, "Chyba": Exit Sub
Application.ScreenUpdating = False
With .Cells(5, 3).Resize(PoslRadekV - 4, 3)
.Formula = Array("=SUMIFS(DATA!$B$2:$B$" & PoslRadekD & ",DATA!$A$2:$A$" & PoslRadekD & ",$B5)", "=VLOOKUP($B5,DATA!$A$2:$B$" & PoslRadekD & ",2,FALSE)", "=COUNTIF(DATA!$A$2:$A$" & PoslRadekD & ",$B5)")
.Value = .Value
End With
Application.ScreenUpdating = True
End With
End Sub
Príklad
Mne by to dávalo zmysel približne takto:
-Ak dosiahne hodnota skladu minimálnu hodnotu 5 - upozornenie na dosiahnutie minimálneho stavu.
-Ak je stav medzi 1-4 (vrátane) - upozornenie na dochádzanie produktu.
-Ak je stav 0 - upozornenie na chýbajúci produkt (tu nechápem použitie makra s názvom "Aktuálne", žeby v zmysle "Je aktuálne priobjednať ďalšie kusy" ??? To sa má robiť pri dochádzaní, nie ?).
- Treba zobrazovať všetky druhy správ, lebo pri viacnásobnej zmene (viac buniek naraz), môže dôjsť k rôznym stavom.
-Treba myslieť nielen na rôzne stavy, ale aj na výpis konkrétnych produktov v konkrétnych stavoch.
-Táto komplexná správa musí vynechať prípadné nepoužité stavy.
-Táto komplexná správa musí mať ikonu najvyššej použitej priority. Preto som pridal, logicky, informačnú ikonu pri dosiahnutí minimálneho stavu 5.
Všetko uvedené obsahuje toto riešenie. Dá sa to vylepšiť, napr. tým, že sa použijú kolekcie, a vylúčia sa duplicitné položky.
Ale. O koľko sa má jednať riadkov ? Je tento počet riadkov stále rovnaký ? Ak nie, čo určuje posledný riadok ? Takéto "upozornenie" by sa dalo asi riešiť (ak položiek nebude 100 000) aj vzorcami tak, že by maticové vzorce, vypisovali vedľa všetky položky, na ktoré treba upozorniť + Podmienené formátovanie. A bolo by to bez makra.
Treba ďalšie info ...
Vyskúšajte či som obsiahol všetky možnosti...
A kde je potom koniec pracovnej doby ? Priložte reálnu prílohu s reálnym rozmiestnením a reálne vyplnenými hodnotami, v ktorých budú zastúpené všetky možnosti, ktoré môžu nastať.
Úprava vzorcov aj makra. Skúste nájsť rozdiel v makre tých dvoch hárkov. Tam bola chyba.
Application.EnableEvents - použite iba ak potrebujete (v popise)
Tak to bude musieť byť asi len makro. Pr.
XLS je starý typ a môže obsahovať makrá, naproti tomu xlsx je novší typ bez možnosti obsahu makier. Na súbor s obsahom makier je xlsm.
Tak malú šírku to považuje za 0.
Dim DisableEvents As Boolean
Const SIRKA_MALA = 0.01
Const SIRKA_VELKA = 10
Private Sub ckbSloupec2_Click()
ZmenaSirky ckbSloupec2
End Sub
Private Sub ckbSloupec3_Click()
ZmenaSirky ckbSloupec3
End Sub
Private Sub ckbSloupec4_Click()
ZmenaSirky ckbSloupec4
End Sub
Private Sub UserForm_Initialize()
DisableEvents = True
ckbSloupec2.Value = List1.Columns(2).ColumnWidth <= SIRKA_MALA
ckbSloupec3.Value = List1.Columns(3).ColumnWidth <= SIRKA_MALA
ckbSloupec4.Value = List1.Columns(4).ColumnWidth <= SIRKA_MALA
DisableEvents = False
End Sub
Sub ZmenaSirky(ckb As MSForms.CheckBox)
If DisableEvents Then Exit Sub
Select Case ckb.Value
Case True: List1.Columns(CByte(ckb.Tag)).ColumnWidth = SIRKA_MALA
Case False: List1.Columns(CByte(ckb.Tag)).ColumnWidth = SIRKA_VELKA
End Select
End Sub
Metóda SpecialCells je v prílohe tiež :)
Také ružové to nieje. A navyše sa nemá hľadať posledný riadok, ale prvá prázdna bunka. Čo je niečo úplne iné. Lenže k nájdeniu správneho riešenia je treba správne zadanie. A to tu absentuje. Kde je ukážková príloha ?
Posielam zopár modelových situácií aj s riešeniami, a upozornením na niektoré možné problémy.
Prípadne sa dá použiť ešte aj Cells(y,x).Find(...)
Dostačovať bude asi aj ten jeden vzorec
Makrom ? Prázdne riadky nemusíte mazať, to sa urobí samé. Stačí iba uložiť súbor.
Sub Nove_data_do_DB()
Dim DA(), RA As Long, DB(), RB As Long, i As Long, rngDel As Range, ColB As New Collection, Vsetko As String, Polozka, PocetNovych As Long
With wsTabA
RA = .Cells(Rows.Count, 1).End(xlUp).Row - 2
If RA = 0 Then Exit Sub
ReDim DA(1 To RA, 1 To 5)
DA = .Cells(3, 1).Resize(RA, 5).Value2
End With
With wsTabB
RB = .Cells(Rows.Count, 1).End(xlUp).Row - 2
If RB > 0 Then
ReDim DB(1 To RB, 1 To 5)
DB = .Cells(3, 1).Resize(RB, 5).Value2
For i = 1 To RB
ColB.Add i, Join(Array(DB(i, 1), DB(i, 2), DB(i, 3), DB(i, 4), DB(i, 5)), "•")
Next i
End If
End With
Erase DB
On Error Resume Next
With wsTabA
For i = 1 To RA
Vsetko = Join(Array(DA(i, 1), DA(i, 2), DA(i, 3), DA(i, 4), DA(i, 5)), "•")
Select Case Len(Vsetko)
Case 4
If rngDel Is Nothing Then Set rngDel = .Cells(i + 2, 1).Resize(, 5) Else Set rngDel = Union(rngDel, .Cells(i + 2, 1).Resize(, 5))
Case Else
Polozka = ColB(Vsetko)
If Err.Number <> 0 Then
PocetNovych = PocetNovych + 1
ReDim Preserve DB(1 To 5, 1 To PocetNovych)
DB(1, PocetNovych) = DA(i, 1): DB(2, PocetNovych) = DA(i, 2): DB(3, PocetNovych) = DA(i, 3): DB(4, PocetNovych) = DA(i, 4): DB(5, PocetNovych) = DA(i, 5)
Err.Clear
End If
End Select
Next i
End With
On Error GoTo 0
If PocetNovych > 0 Then wsTabB.Cells(RB + 3, 1).Resize(PocetNovych, 5).Value2 = WorksheetFunction.Transpose(DB)
If Not rngDel Is Nothing Then rngDel.Delete Shift:=xlUp
End Sub
Skúšajte to výhradne na fyzickej kópii súboru !!!
No tomu práve nerozumiem, ako má makro zistiť, ktorý súbor patrí do ktorej skupiny, aby mohlo zasiahnuť a zatvoriť predošlý súbor z danej skupiny. Nejako sa musia rozlišovať.
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články