Příspěvky uživatele

- Dám kurzor niekam do Tabuľky DataTab
- "Údaje" - "Z tabuľky alebo rozsahu" - vytvorí sa základné načítanie Tabuľky do PQ
- Zmažem zatiaľ zbytočný automatický krok "Zmenený typ" pomocou "X"
- Označím pomocou Ctrl dva kontingenčné stĺpce "Hospodářské středisko" a "Registrační značka"
- "Transponovat" - "Zrušit kontingenčnosť stĺpcov" - podmenu "Zrušiť kontingenčnosť ostatných stĺpcov"
- Vo vzniknutom kroku "Zrušenie kontingenčnosti ostatných stĺpcov" vznikli 2 stĺpce. "Atribút" sú hlavičky doterajších dátových stĺpcov, teda názvy mesiacov. A "Hodnota" sú hodnoty.
- Názvy týchto dvoch stĺpcov sa mi nepáčia tak ich zeditujem na "Měsíc" a "Částka" priamo v tom kroku v riadku na písanie príkazu, hore nad tabuľkou. Dám Enter na potvrdenie.
- Stĺpec "Měsíc" presuniem potiahnutím pred 1. stĺpec, aby som mal požadované poradie stĺpcov
- Oznnačím pomocou Ctrl 3 stĺpce "Měsíc", "Hospodářské středisko", "Registrační značka" a na karte "Domov" - "Typ údajov" - "Text"
- Označím stĺpec "Částka" a na karte "Domov" - "Typ údajov" - "Desatinné číslo"
- Vpravo hore si môžem dať rozumný názov pre dotaz. Bude sa tak volať aj Tabuľka.
- Na karte "Domov" - "Zavrieť a načítať" - vytvorí nový list s dotazom, a podmenu "Zavrieť a načítať do" umožní nevytvárať list, ale vybrať miesto vloženia výsledku (napr. aktuálny list nejaká bunka), alebo iba vytvoriť prepojenie pre KT, prípadne vložiť dáta dotazu do Dátového modelu na ďalšie spracovanie. Teda výsledok dotazu nemusí byť zobrazený.

Všetky riadky alebo iba vyfiltrované?
Sú tam nejaké skryté stĺpce, ktoré treba vynechať?
Rozsah stĺpcov?
Je to tabuľka alebo Tabuľka?
"otevřený list" - takže tých listov je viac, a Vy potrebujete takto spracovať iba aktuálne aktívny list? Takže na každom takom liste je tlačítko? Alebo je ovládacie tlačítko na inom liste - v tom prípade to nemôže platiť na "otevřený list".

Do súboru od Jiřího som pridal aj jednoduché PQ riešenie.

To je úplne jednoduché.
Sub DeleteRows()
Dim rngDel As Range, DelCount As Long, D(), i As Long, colDel As New Collection, Check

D = wsHodnoty.ListObjects("tblMazatHodnoty").ListColumns(1).Range.Value2
On Error Resume Next
For i = 2 To UBound(D, 1) 'vytvoření kolekce mazaných hodnot z tblMazatHodnoty
colDel.Add CStr(D(i, 1)), CStr(D(i, 1))
Next i

With wsFaktury.ListObjects("DataFaktury")
With .ListColumns(11).Range
D = .Value2

For i = 2 To UBound(D, 1)
Check = colDel(CStr(D(i, 1))) 'mazat při hodnotách z tblMazatHodnoty, hodnoty lze lehce editovat
If Err.Number = 0 Then
If rngDel Is Nothing Then Set rngDel = .Cells(i) Else Set rngDel = Union(rngDel, .Cells(i))
Else
Err.Clear
End If
Next i
End With
On Error GoTo 0

If rngDel Is Nothing Then MsgBox "Žádné řádky k smazání", vbInformation: GoTo KONEC 'žádné řádky k smazání

DelCount = rngDel.Cells.Count
Intersect(.DataBodyRange, rngDel.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & DelCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With

KONEC:
Set colDel = Nothing
End Sub
A nebolo by pre Vás vhodnejšie PowerQuery s výslednou Tbl do druhého listu/súboru ???

Pozerám, že po rokoch už tu ten môj súbor nie je. Našiel som ho na inom fóre, kam som ho tiež posielal. Skúšal som funkčnosť aj na mBank.

Takto?
Sub DeleteRows()
Dim rngDel As Range, DelCount As Long, D(), i As Long, bDel As Boolean

With wsFaktury.ListObjects("DataFaktury")
With .ListColumns(11).Range
D = .Value2
For i = 2 To UBound(D, 1)
bDel = IsError(D(i, 1)) 'mazat při chybě
If Not bDel Then
Select Case D(i, 1)
Case "něco", 900: bDel = True 'nebo mazat při těchto hodnotách, hodnoty lze lehce přidat
End Select
End If

If bDel Then If rngDel Is Nothing Then Set rngDel = .Cells(i) Else Set rngDel = Union(rngDel, .Cells(i))
Next i
End With

If rngDel Is Nothing Then MsgBox "Žádné řádky k smazání", vbInformation: Exit Sub 'žádné řádky k smazání

DelCount = rngDel.Cells.Count
Intersect(.DataBodyRange, rngDel.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & DelCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With
End Sub

Ja by som to videl na SpecialCells
Sub DeleteRows()
Dim rngErr As Range, ErrCount As Long

With wsFaktury.ListObjects("DataFaktury")
On Error Resume Next
Set rngErr = .ListColumns(11).Range.SpecialCells(xlCellTypeFormulas, xlErrors) 'všechny buňky s chybou ve 11. sloupci Tabulky
On Error GoTo 0

If rngErr Is Nothing Then MsgBox "Žádné chyby", vbInformation: Exit Sub 'žádné chyby

ErrCount = rngErr.Cells.Count
' If ErrCount = .DataBodyRange.Rows.Count Then .ListRows.Add 'asi není potřeba, ale pokud jsou všechny buňky s chybou, přidej 1 řádek, pro zachování vzorců a formátů

Intersect(.DataBodyRange, rngErr.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & ErrCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With
End Sub

alebo aj

Možností je mrte...
Napadajú ma ďalšie 2

Asi by som to počítanie smien urobil úplne inak. S pomocou referenčnej tbl., ktorú zadáte raz na cyklus ktorý viete, a ostatné sa cyklicky dopočíta vzhľadom na rozdiel počtu dní medzi daným dátumom a referenčným dátumom.

Môj mail vidíte v konte...

Tak skúste za 1. vzorec vložiť ako maticový, nie obyč. Enter ale Ctrl+Shift+Enter, a za 2. pridajte overenie farby pomocou vyhľadania reťazca:
=PERCENTILE(IF(IFERROR(SEARCH($E7;$A$2:$A$81);)*($B$2:$B$81=F$6);$C$2:$C$81);F3)
=PERCENTIL(KDYŽ(IFERROR(HLEDAT($E7;$A$2:$A$81);)*($B$2:$B$81=F$6);$C$2:$C$81);F3)

Ak to chcete napáskovať na nejaký požadovaný vizuál, tak si ho najskôr pripravte, vylaďte tlač so štítkovým papierom, a makro treba potom prispôsobiť. Lebo ja som počítal s rozložením tak ako je, napr. aj PF na skrývanie orámovania nepoužitých štítkov je nastavený na oblasť každého štítku. Ozvite sa, keď bude treba.

Tak nad tým čo to má kde robiť, čo chcete hľadať, čo to robí zle, čo to nerobí, ako má vyzerať výsledok, ... sa mi moc premýšľať nechce. Takže čo Vám nefunguje?

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje