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 ".".
Ja narážam na to, odkiaľ mi vieme, či Novák Petr má mail na nejakom servery, a odkiaľ vieme, či je to novakpetr@xy.cz / petrnovak@xy.cz / novak.petr@xy.cz / ...
Mi to musíme nejako vedieť, keď chcem aby bol hypertextový odkaz funkčný.
A ak to vieme, kto má kde mail v akej podobe, tak postrádam zmysel v tomto spájaní, lebo keď to vieme, niekde takú infošku už asi máme v DB. Či ???
Najskôr si pozrite, či je toto to, čo potrebujete. Potom Vám na to spravím makro, ak dodáte prílohu, aby bolo jasné kde sú data, od ktorého po ktorý riadok, hromadne na X riadkov ...
A vysvetlite, čo myslíte tým odkazom. Hypertextový odkaz? Na mail, ktorý neexistuje? Alebo všetky tie mená majú vytvorený mail? Treba sa zbavovať aj medzier (to som tam dal). Má to byť UDF funkciou (tak ako teraz funguje pri zmene dát), alebo makrom zapísané jednorázovo? Málo info.
PS: odstránenie diakritiky vycucané z riešenia od eLCHa.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.