• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Tak som sa pokúsil to vyriešiť pomocou maticového vzorca, bez pomocného hárku alebo stĺpca. Čisto vzorec, teoreticky umiestniteľný celý do bunky, ale to by som už následne neupravil ani ja ako autor :) Už takto keď som to rozložil na Definované Názvy, je to HardCore. Na toto by sa mala použiť asi Kontingenčná Tabuľka.

Každopádne si porovnajte výsledky, pretože mi s Vašimi jedny nesedia (tuším početnosť príčin v mesiaci). Neskúmal som ostatné vzorce, len tie 3 tbl v roku a 3 tbl v mesiaci, ktoré ste chcel zoraďovať. Teda či sa Vám odkazuje ešte niečo na tie pomocné listy netuším.

A ako berie tých niekoľko cieľových zošitov hodnoty zo zdrojového zošitu ? Vzorec ? Aktualizuje sa sám. Dotaz ? Stačí dať Údaje - Obnoviť všetko. Hodnoty sú natvrdo skopírované ? Jedine makrom, a to bude každý súbor na pozadí otvárať a znovu natvrdo vkladať dáta (podľa nejakých Vami nešpecifikovaných podmienok) a súbory ukladať.

Priložte prílohu s príkladom zdrojového, cieľového súboru, a prípadných podmienok manuálnej aktualizácie.

=MIN(3;FLOOR(D7/5000;1))
=MIN(3;ZAOKR.DOLŮ(D7/5000;1))

Ešte som Vám urobil malú zmenu:

-Odstránil som zabudnutú premennú na kontrolu počtu výsledkových stĺpcov, lebo ak to je takto, tak sú vždy len 2.
-Počet riadkov a stĺpcov ku kontrole sa určuje podľa A:A a 1:1.
-Urobil som nejakú kontrolu na neexistenciu dát.
-A hlavne som Vám detailne popísal každý riadok kódu, aby ste možno aj porozumel tomu, ako to funguje. To je dôležité, aby ste vedel povedať prípadne, že sme vyradili dáta, ktoré mali byť validné.
-V zdrojových dátach ste mal v bunkách B2344, B3326, B4171 to číslo ako text. Dáta by mali byť konzistentné.
-V kóde je zakomponovaná možnosť ukončenia/pokračovania kontroly v riadku pri nájdení prázdnej bunky. Popis v kóde - hľadajte ####

Pekný deň :)

Teda sa majú vypísať iba tie riadky dát, v ktorých je od stĺpca B aspoň 1 nejaké číslo ? A ak tam je, tak vo výsledku bude v A najskôr číslo z A zdroja (nejaké ID), a vedľa postupne pod sebou čísla z B:CV, a to tak, že sa V A opakuje stále to isté ID, ktoré im náleží z riadku zdroja ?

Z toho mi vyplýva, že riadky, ktoré majú iba ID v stĺpci A, a nemajú žiadne ďalšie čísla v B:CV, sa do výsledku zahrnúť nemajú. Je to tak ?

Platí teda, že sa prehľadávanie riadku zdroja končí v momente nájdenia 1. nečísla v B:CV ? Alebo sa musí vždy prehľadať celý riadok B:CV ? Proste či sú v riadku medzery.

Ak je to inak, dajte konkrétny príklad, ako sa majú vyhodnotiť načrtnuté situácie.

Tu je nástrel.
Sub VypisCisla()
Dim D(), Sloupcu As Integer, Radku As Long, y As Long, x As Integer, Col As New Collection, Polozka, Cisla() As Double, PocetCisel As Long, RadkuCelkem As Long, SloupcuCelkem As Integer

Sloupcu = 100
Radku = 10000
ReDim D(1 To Radku, 1 To Sloupcu)
D = Worksheets("VSTUP").Cells(2, 1).Resize(Radku, Sloupcu).Value

On Error Resume Next
For y = 1 To Radku
PocetCisel = -1
For x = 2 To Sloupcu
If LenB(D(y, x)) > 0 Then
If IsNumeric(D(y, x)) Then
PocetCisel = PocetCisel + 1
ReDim Preserve Cisla(PocetCisel)
Cisla(PocetCisel) = D(y, x)
End If
End If
Next x
If PocetCisel > -1 Then
Col.Add Array(D(y, 1), Cisla)
RadkuCelkem = RadkuCelkem + PocetCisel + 1
If PocetCisel > SloupcuCelkem Then SloupcuCelkem = PocetCisel
End If
Next y
On Error GoTo 0

With Worksheets("CIL")
.UsedRange.ClearContents
If RadkuCelkem > 0 Then
ReDim D(1 To RadkuCelkem, 1 To SloupcuCelkem + 1)
y = 0
For Each Polozka In Col
For x = 0 To UBound(Polozka(1))
y = y + 1
D(y, 1) = Polozka(0)
D(y, 2) = Polozka(1)(x)
Next x
Next Polozka
.Cells(1, 1).Resize(RadkuCelkem, SloupcuCelkem + 1).Value = D
End If
End With
End Sub

Je viac možností. Ak by sa napríklad nevolal list v tých súboroch rovnako, dá sa cez ADO zistiť názov listu bez otvorenia súboru. Ale to už je otázka, či potom neprečítať rovno aj hodnoty cez ADO.

Ak sa ale volajú listy rovnako, tak vyššie uvedené bude asi najrýchlejšie riešenie.

PQ nezavrhujte, dajú sa tam robiť psie kusy, a zrovna mepexg je macher. Navyše nemusia byť povolené makrá (firemná fóbia).

Nie ERF(1) ale ERF(1;), tak som to radšej nahradil NA(), A píšem maticový vzorec, nie normálny. Teda potvrdenie vzorca je Ctrl+Shift+Enter. Nie len Enter.

Maticový vzorec:
=IF(COUNT(H20:H34)=0;NA();SUM(IFERROR(H20:H34;0)))
=KDYŽ(POČET(H20:H34)=0;NEDEF();SUMA(IFERROR(H20:H34;0)))

Alebo aj niečo podobné:
Sub SouhrnDat2()
Dim D() As String, Soubory() As String, Soubor As String, Cesta As String, Pocet As Long

Cesta = ThisWorkbook.Path & "\"
Soubor = Dir(Cesta & "*.xlsx", vbHidden)
While Soubor <> ""
Pocet = Pocet + 1
ReDim Preserve Soubory(1 To Pocet)
Soubory(Pocet) = Soubor

ReDim Preserve D(1 To Pocet)
D(Pocet) = "='" & Cesta & "[" & Soubor & "]List1'!B$1"
Soubor = Dir()
Wend

If Pocet > 0 Then
With List1.Cells(2, 1).Resize(Pocet)
.Value = Application.Transpose(Soubory)
With .Offset(0, 1).Resize(Pocet, 4)
.Formula = Application.Transpose(D)
.Value = .Value
End With
End With
End If
End Sub

Redim poľa a následné Transpose som nepoužil naschvál, kvôli možnosti, že v takom množstve buniek môže byť ľahko aj 32767 hodnôt. No a tam Transpose končí.

EDIT: A ešte treba dať pozor, a vybrať si správne verziu podľa potrieb. Rozdiel je napr. aj v tom, kolegove makro ide zľava doprava, a ak je prázdna cyklus končí. Ja som sa držal zadania, že hodnota môže byť hocikde, nielen zľava.

Možno aj takto. Ale radšej by som zisťoval počet riadkov a stĺpcov, ako to mať na pevno.
Sub VypisCisla()
Dim D(), Sloupcu As Integer, Radku As Long, y As Long, x As Integer, Col As New Collection, Polozka

Sloupcu = 100
Radku = 10000
ReDim D(1 To Radku, 1 To Sloupcu)
D = Worksheets("VSTUP").Cells(2, 1).Resize(Radku, Sloupcu).Value

On Error Resume Next
For x = 1 To Sloupcu
For y = 1 To Radku
If LenB(D(y, x)) > 0 Then
If IsNumeric(D(y, x)) Then Col.Add D(y, x)
End If
Next y
Next x
On Error GoTo 0

With Worksheets("CIL")
.Columns(1).ClearContents
Radku = Col.Count
If Radku > 0 Then
ReDim D(1 To Radku, 1 To 1)
y = 0
For Each Polozka In Col
y = y + 1
D(y, 1) = Polozka
Next Polozka
.Cells(1, 1).Resize(Radku, 1).Value = D
End If
End With
End Sub

Skúste toto
Sub FilterVBA()
Dim Radku As Long, Pole()
With wsSAP.UsedRange
Radku = .Rows.Count - 1
With .Columns(2).Offset(1, 0).Resize(Radku)
ReDim Pole(1 To Radku, 1 To 1)
Pole = .Value2
.NumberFormat = "@"
For i = 1 To Radku
Pole(i, 1) = CStr(Pole(i, 1))
Next i
.Value2 = Pole
End With
.AutoFilter 2, "=20121*", Operator:=xlAnd
End With
End Sub

Ale na generovanie QR kódov sú na tej stránke predsa ďalšie parametre čo som pozeral. A my nevieme aké majú byť použité pre výsledok, ktorý nevidíme, lebo prepojenie na pripojený (nie vložený) obrázok nefunguje.

Zaregistrujte sa a priložte prílohu, aby bolo zrejmé, čo chcete presne urobiť. Ak sa jedná o viacnásobné hľadanie, napr. porovnávanie 2 zoznamov, tak obe tieto metódy sú pomalé. Na to sa dá výhodne a rýchlo použiť Collection. Ak ide o jednorázové použitie v pohode.
Zhrnutie:
ak Application.Match() tak IsError() test, ak WorksheetFunction.Match(), tak On Error Resume Next + If Err.Number <> 0 Then. Ale dá sa použiť aj CountIf, no tá bude ešte pomalšia.
Chce to prílohu.

V tom prípade je treba započítať do toho odsadenie jednoduchou úpravou:
Function ISFILTERED(Col As Range) As Boolean
Dim i As Long, iCol As Long, iRng As Long
Application.Volatile
iCol = Col.Column
With Col.Parent.AutoFilter
iRng = .Range.Column - 1
For i = 1 To .Filters.Count
If .Filters(i).On And i = iCol - iRng Then ISFILTERED = True: Exit For
Next i
End With
End Function
Nevidel som síce prílohu s Rýchlymi filtrami od mepexg, ale tiež ich radšej odporúčam. Ak chcete silou-mocou Podmienený formát a ani táto úprava nieje podľa gusta, priložte súbor nech nehádame.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse