Příspěvky uživatele

Vymenil som kód aj prílohu v predošlom príspevku. Ja to lepšie opísať neviem. Opis trval dlhšie ako programovanie

Už to tu tuším niekto písal, že to inak nejde.
Makro nemusí byť v žiadnom jeho zošite. Môže sa dať ako univerzál do PERSONAL.XLSB, a volať čudlíkom v lište nad práve otvoreným zošitom. Teda jeho súbory budú bez makra.

Čo ja by som tiež všetko chcel ...

Na spojenie dvoch Range by som použil Union, a tým pádom by všetko aj s ClearContents prebehlo v jednom kroku.

Pokus

Čítanie s porozumením je fenomén dnešnej doby. Totiž konkrétne jeho presný opak :)
marjankaj Vám písal, aby ste dal prílohu s tým čo máte, a potom ukázal, ako má to isté vyzerať po úprave. Vy píšete, že "toto" je na začiatku, a následne napíšete, že to je výsledok :)

No neva. Vidím to zatiaľ takto:
Máte nejakú šablónu, list kde nič nieje, iba správne nastavené formáty, nič nieje zlúčené.
Do tohto listu nakopírujete/importujete hodnoty (iba hodnoty).
Máte nejaký určovací stĺpec (asi A), podľa ktorého sa určuje, ktoré riadky sa budú zlučovať. Rovnaké číslo v stĺpci A sa zlučuje. Ak je tam pod sebou 5 rovnakých, znamená, že sa zlúči týchto 5 riadkov v A.
Podľa týchto 5-ich rovnakých riadkov zo stĺpca A, zlučujeme samostatne aj stĺpce C, J - AA, ale iba v prípade, že medzi tými 5-imi riadkami daného stĺpca sú vôbec nejaké data. Teda napr v P6:10 nie sú data, tak sa nezlučujú, ale v P2:P4 sú data, tak sa zlúčia.
A čo s dátami "- - -" v S,V,Y ?

A teraz ešte k zlúčeným riadkom. Prečo sa nezlučuje stĺpec B (veď má rovnaké dáta)?

Ďalej vo vyššie menovaných stĺpcoch, ktorých sa zlučovanie týka, môže nastať, aby napr. v P6:P10 boli rôzne dáta? Teda nie rovnaké? V tom prípade nie zlúčiť (Merge), ale najskôr spojiť (Join) a následne Merge. Teda viac riadkov v jednej bunke. S takýmito bunkami sa nebude dať potom už pracovať v zmysle súčtov, počtov, filtrov a pod. A navyše je možné že tieto spojené a následne zlúčené dáta a bunky budú mať iný formát (číslo+text alebo červené+zelené a pod)? To by bolo riešiteľné dosť komplikovane, pretože by sa museli prechádzať takmer všetky mysliteľné možnosti formátu, farby, písma a ... Rôznorodý Podmienený formát by samozrejme logicky nemohol nikdy fungovať.

Snáď bude teraz komunikácia zrozumiteľnejšia, lebo podľa mňa nieje jasné o čo ide.

Sub Neshoda()
Dim D(), N() 'pole Dodacích listů a pole Neshod
Dim ColD As Collection 'kolekce Dodacích listů, vhodná pro rychlé ověření zda kolekce danou položku obsahuje
Dim Item 'dohledaná položka z předešlé kolekce ColD, položka se na nic nepoužije, slouží jenom na prípadné vyvolání chyby, co ověří existenci
Dim RadkuD As Long, RadkuN As Long 'počty řádků v Dodacích listech a v Neshodách, slouží k určení velikosti polí, do kterých se načtou data
Dim i As Long 'iterační proměnná pro cyklus
Dim RNG As Range 'oblast, která se bude mazat, postupně se do ní přidávají neshodné řádky

With Sheets("Dodáky") 'pracuj s listem "Dodáky", následně se použije tečková notace, určuje práci s nadřazeným objektem ve "With", napr: .Cells()
RadkuD = .Cells(Rows.Count, 1).End(xlUp).Row - 1 'zjisti počet řádkú Dodáků v sloupci 1 (A) {nalezne poslední vyplněný řádek - hlavička}
Select Case RadkuD 'podle počtu řádků vykonej akci
Case 0: MsgBox "Žádné dodací listy", vbExclamation: Exit Sub 'když nejsou Dodáky, oznam a odchod
Case 1: ReDim D(1 To 1, 1 To 1): D(1, 1) = .Cells(2, 1).Value 'při načtení dat o velikosti 1 položky do pole, je nutné definovat nejdřív velikost pole, pak do 1. položky načíst bunku
Case Else: D = .Cells(2, 1).Resize(RadkuD).Value 'při více jak 1 položce pak stačí jenom načíst všechny bunky o patřičné výšce (RadkuD) do prázdného pole
End Select
End With 'ukonči práci s listem Dodáky

'totéž jako s Dodáky provedeme s načtením Neshod do pole N
With Sheets("Neshoda")
RadkuN = .Cells(Rows.Count, 1).End(xlUp).Row - 1
Select Case RadkuN
Case 0: MsgBox "Žádné neshodné dodací listy", vbExclamation: Exit Sub
Case 1: ReDim N(1 To 1, 1 To 1): N(1, 1) = .Cells(2, 1).Value
Case Else: N = .Cells(2, 1).Resize(RadkuN).Value
End Select

Set ColD = New Collection 'vytvoří se objekt, nová prázdná kolekce, potřebné pro vytvoření vyhledávacího "seznamu" dodáků

For i = 1 To RadkuD 'projdeme cyklem celé pole Dodáky, a každý dodák přidáme do kolekce pod vyhledávacím klíčem, co je císlo Dodáku převedené na řetezec CStr(D(i, 1))
'samotný údaj v kolekci je irelevantní, ale je potřebné metodě .Add předat i první parametr, ale ten múže být klidně 0 apod.
ColD.Add D(i, 1), CStr(D(i, 1)) 'pridání vyhledávacích klíču do kolekce
Next i

On Error Resume Next 'tady přebíráme odchycení chyb, protože pri nenalezení položky Neshody ve vyhledávaci kolekci Dodáků, by vznikla chyba makra, toho využijeme a chybu použijeme na mazání
For i = 1 To RadkuN 'projdeme cyklem celé pole Neshody
Item = ColD(CStr(N(i, 1))) 'TADY JE TA SRANDA - podle vyhledávacího klíče, který teď vytvoří převod Neshody na řetezec CStr(N(i, 1)), skusíme najít v kolekci Dodák, případný nález
'se přiřadí do proměnné Item - irelevantní. Při tom ale, když najde tak chyba Err je 0, ale když nenajde vyvolá se chyba Err, a to testujeme
If Err.Number <> 0 Then 'když nastala ve vyhledání Neshody mezi Dodáky chyba, znamená to, že takový Dodák není, a teda řádek v Neshody bude přiřazen následně do mazané oblasti
If RNG Is Nothing Then Set RNG = .Cells(i + 1, 1) Else Set RNG = Union(RNG, .Cells(i + 1, 1)) 'když je oblast mazání prázdná tak nastav bunku ze sloupce 1 (A) a řádku podle iterační
'proměnné cyklu "i" + hlavička, tedy .Cells(i + 1, 1)
'používamé skrácenou tečkovou notaci .Cells() protože jsme stále pod nadřazením objektem ve With
'když oblast RNG prázdná není, tedy uý som v ní zaznamenány nějaké bunky na mazání, jenom
'k ní pomocí Unio() přidej další. Je to vhodné právě pro hromadné akce s nesouvislími oblastmi
Err.Clear 'po odchycení a spracování chyby, ji musíme zmazat, protože by jinak nastalo mazání nesprávné oblasti i když by následné hledáni prošlo a chybu by samo o sobě nevracelo
End If
Next i
On Error GoTo 0 'po dokončení celého cyklu vypneme odchytávání chyb makra
End With 'ukonči práci s listem Deshody

If Not RNG Is Nothing Then RNG.EntireRow.Delete 'jestli byli do mazané oblasti přiřazené nejaké bunky Neshod, celé řádky najednou vymaž

Set ColD = Nothing 'i když to VBA dělá většinou automaticky po skončení procedury, je vhodné objekty z paměti zmazat
End Sub

Vzorec pomocou FREQUENCY/ČETNOSTI. V príklade 2 nerozumiem, prečo má byť pri vyradených výsledok 2. Pretože mne logicky pripadá, že každý vyradený riadok diskvalifikuje sám seba. Teda 0 :)
Ale to PQ/KT bude OK.

príklad:
Sub vyber()
Dim OsobniCislo As String, Jmeno As String

ZADAJ:
OsobniCislo = InputBox("Zadej osobní číslo:")
If StrPtr(OsobniCislo) = 0 Then Exit Sub
If Not IsNumeric(OsobniCislo) Then GoTo ZADAJ
On Error Resume Next
Jmeno = Application.WorksheetFunction.VLookup(CDbl(OsobniCislo), Range("Skupina"), 2, 0)
If Err.Number <> 0 Then
Err.Clear
GoTo ZADAJ
Else
With Worksheets("List1")
.Range("OsobniCislo").Value = CDbl(OsobniCislo)
.Range("Jmeno").Value = Jmeno
End With
End If
On Error GoTo 0
End Sub

Zaujímavý nápad, ako ľahko určovať, ktoré bunky zahrnúť, len nevieme podrobnosti.
Ako prichádza k aktualizácii (či by bolo pracné ich takto "transponovať")?
Menia sa tie bunky za iné?
Aké sú podmienky, ktoré započítať a ktoré nie (na základe nejakých podmienok sa predsa zazelenajú)?
...

A ako prídete na to, že práve iba z týchto buniek sa bude vždy robiť priemer???

Vstupné dáta naformátujte ako Tabuľku, pridajte jeden stĺpec na určenie ročného obdobia, napr.:
=CHOOSE(INT((MONTH([@Dátum])-INT(MONTH([@Dátum])/12)*12)/3)+1;"Zima";"Jar";"Leto";"Jeseň")
=ZVOLIT(CELÁ.ČÁST((MĚSÍC([@Dátum])-CELÁ.ČÁST(MĚSÍC([@Dátum])/12)*12)/3)+1;"Zima";"Jar";"Leto";"Jeseň")
A použite SmartFiltre na roky a ročné obdobia.

Na všemožné analýzy, kontingenčky, PQ dotazy je neskutočný kúzelník MePExG. Ale tá príloha ...

Zložitejšie riešenie:
Definovaný názov OBLAST
={"'Hárok1'!$A$1";"'Hárok1'!$A$3";"'Hárok1'!$C$5:$C$6";"'Hárok1'!$G$4:$H$9"}
maticový vzorec
=SUM(SUMIF(INDIRECT(OBLAST);"<3"))/SUM(COUNTIF(INDIRECT(OBLAST);"<3"))
=SUMA(SUMIF(NEPŘÍMÝ.ODKAZ(OBLAST);"<3"))/SUMA(COUNTIF(NEPŘÍMÝ.ODKAZ(OBLAST);"<3"))
prípadne nematicový
=SUMPRODUCT(SUMIF(INDIRECT(OBLAST);"<3"))/SUMPRODUCT(COUNTIF(INDIRECT(OBLAST);"<3"))
=SOUČIN.SKALÁRNÍ(SUMIF(NEPŘÍMÝ.ODKAZ(OBLAST);"<3"))/SOUČIN.SKALÁRNÍ(COUNTIF(NEPŘÍMÝ.ODKAZ(OBLAST);"<3"))
prípadne nematicový a bez použitia def. názvu s jednoduchším pridaním oblastí
=SUMPRODUCT(SUMIF(INDIRECT("'Hárok1'!"&{"A1";"A3";"C5:C6";"G4:H9"});"<3"))/SUMPRODUCT(COUNTIF(INDIRECT("'Hárok1'!"&{"A1";"A3";"C5:C6";"G4:H9"});"<3"))
=SOUČIN.SKALÁRNÍ(SUMIF(NEPŘÍMÝ.ODKAZ("'Hárok1'!"&{"A1";"A3";"C5:C6";"G4:H9"});"<3"))/SOUČIN.SKALÁRNÍ(COUNTIF(NEPŘÍMÝ.ODKAZ("'Hárok1'!"&{"A1";"A3";"C5:C6";"G4:H9"});"<3"))

OT: @eLCHa: Na to nemám žiaden dosah. Ja len hasím, čo mi zavolajú :(

Ak nedáte prílohu, urobte aspoň screenshot danej oblasti. V piatok som podobnú somarinu riešil so mzdárkou. SAP jej dáva číslo, čo nieje číslo ani po vynásobení 1*, lebo aj keď má desatinný oddeľovač "," stále je tam oddeľovač tisícov ".".

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje