Příspěvky uživatele

Šmarjá ... čo znamená "Nefunguje" ???

"Zdrojové formáty jsou různé" - ale veď jasné, veď preto to riešime univerzálne, a nie napevno.

"nějaké hodnoty v buňkách mimo rámec řádků" - áno správna dedukcia, riešenie je jednoduché.

Chýba mi od Vás odpoveď na to, čo sa pýtam.
Sub FormatVstup()
MsgBox wsImport.Range("B2").NumberFormat
End Sub
Vložíte data do listu Import, a spustíte toto makro FormatVstup (samozrjeme s adresou tej bunky, ktorá robí problém s dátumom). Aký je to formát?

Obdobu predchádzajúceho makra
Sub FormatVystup()
MsgBox ActiveWorkbook.ActiveSheet.Range("B2").NumberFormat
End Sub
spustite po otvorení hotového súboru v ktorom je ten údaj uložený (ten problematický), so správnou adresou, ktorá naň ukazuje. Odpoveď je?

Tieto 2 makrá (FormatVstup, FormatVystup) spustite a referujte na tom mojom testovacom súbore a mojich testovacích dátach a výsledku. A potom na svojom súbore a svojich testovacích dátach a výsledku. Chcem všetky 4 odpovede.

Predpokladám konzistentné formáty pre celý stĺpec. Opakujem, čo som písal, lebo nečítate a/alebo nereagujete. To, aký bude bunkám nastavený formát určujem podľa 1. dátovej bunky pod hlavičkou ! Predpokladám, že nie sú dáta pod sebou takto:
číslo
text
dátum
text čo nie je dátum
desatinné číslo
text
...
ale že sú pod sebou takto:
číslo
číslo
číslo
...
ďalší stĺpec
text čo nie je dátum
text čo nie je dátum
text čo nie je dátum
...
ďalší
dátum
dátum
dátum
...
Čakám odpoveď, na všetky otázky.

Vami popisovaný problém s prevodom na dátum totiž nedokážem navodiť. Niečo nerobíte alebo neuvádzate správne.

Pred
.Protect ...
dajte
Range("Tabulka1[příjmení, jméno]").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Select

Aj v tom mojom pokusnom súbore Vám to "3758/4/11" prevedie na dátum, alebo iba na Vašich reálnych dátach? Mne na E2019x64 SK Pro to funguje tak ako chcete. Aký formát máte v prvej dátovej bunke toho stĺpca (teda v 2. riadku daného stĺpca).
MsgBox ActiveSheet.Range("B2").NumberFormat

Skúste

Môžete si vytvoriť iba prepojenie (bez výslednej tbl) - ten Váš bod "9.1. Vytvoří list s dotazem", a potom vyvolať neskôr tak, že na karte "Údaje" - "Dotazy a pripojenia" - vpravo kliknete pravým na dotaz (zatiaľ iba to prepojenie) a dáte "Načítať do" - a tam si vyberiete nový list alebo bunku alebo dátový model či KT.

Hmm, no to nebude také ľahké. Sú tam záludnosti, napr. skutočný dátum to potom uloží ako číslo. Každopádne v prvom makre je obabrávka tak, že sa zmení formát najskôr na text, vložia sa data, a následne sa formát znovu zmení na Všeobecný/Obecný/General. Ale spomínaný negatívny efekt.

Druhé makro je už väčšia ojebabrávka. Urobí si kolekciu formátov (pre prípadnú zmenu väčšieho počtu stĺpcov na rovnaký formát). A iba pri General urobí predchádzajúcu popisovanú zmenu na text a naspať na General. Dáta teda ostanú v pôvodnom formáte (podľa prvej bunky v stĺpci).

Ak by ani toto nestačilo, tak urobíme klasickú metódu Copy + Paste. To bude najpomalšia metóda, ktorej som sa chcel najskôr vyhnúť (preto relatívne zložitá kolekcia+pole).

- 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

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje