Příspěvky uživatele
< návrat zpět
Na toľko 90-znakových častí, na koľko stĺpcov si natiahnete vzorec. Pre zjednodušenie prípadných úprav či pre menšiu výpočtovú náročnosť by bolo vhodné použiť pomocný stĺpec ako v 2 hárku.
2 rôzne návrhy. Zapnite si prípadne, ak chcete naozaj tie listy odkrývať, lebo na vytiahnutie dát to nieje potrebné.
A napadol ma ďalší návrh, keď by sa aktualizovali nie hodnoty, ale vzorce, ktoré by udržovali stále aktuálne hodnoty v daných listoch. Riešení je veľa. Dáta som si vymyslel.
Ukážte ten "iný zošit". Akú hodnotu má "k", "Stlpcov", a Ubound(v,2) ?
Ďalej nad tým je
With .Range(.Cells(Rows.Count, 4).End(xlUp), .Cells(4, 10))
Teda hľadá posledný vyplnený riadok, aby mohol zmazať predošlé výsledky. Je to v novom zošite rovnako umiestnené ako v tom čo ste dal ?
Nezasahuje to do zlúčenej bunky (ako v predošlom Vašom súbore, tam som zlúčenie zrušil) ?
...
Vypĺňanie buniek po jednej je pomalé. Použitie poľa to skráti na zlomok.
Problém pri 3 prevodových stupňoch je pravdepodobne prekročenie limitu riadkov v Exceli. Určite potrebujete všetky tieto cykly ? Spočítal ste si koľko je to cyklov ? Je to 13 107 200 000. Doba výpočtu je ohromná. Určite musí byť každý cyklus od 20 do 100 ? Treba nájsť iný spôsob výpočtu toho čo potrebujete ako výsledok. Lebo mne sa nezdá, že by ste potreboval spleť čísel vo viac ako milión riadkoch v 7 stĺpcoch, a celé počítané v 13 miliardách cyklov.
Výpočet "i" je určite správny ? Lebo je to :
(podriadený cyklus / nadriadený cyklus) * (podriadený cyklus / nadriadený cyklus) * (nadriadený cyklus / podriadený cyklus)
Nemá byť tretia dvojica opačne ?
Snáď Vám pomôže nejaký matematik ... 
Problém bude v deklarácii API funkcií. Ale je to často zamotané, lebo treba zistiť na nete ktorá API používa parametre akých typov. Od VBA7 (2010) sa používa PtrSafe, dovtedy pre VBA6 nie. Potom sa parametre líšia podľa 32/64 bit Long vs LongLong, ktoré by mala ale v nových Officoch zastrešiť LongPtr obidve. Problém ale je, že niektoré API stále používajú pre parametre Long aj na 64-bitoch. Potom je to nestabilné. Preto treba dohľadať konkrétne tieto Vami použité deklarácie všetkých API, a zapísať ich pomocou podmienenej deklarácie.
#if Vba7 then
' Code is running in the new VBA7 editor
#if Win64 then
' Code is running in 64-bit version of Microsoft Office
#else
' Code is running in 32-bit version of Microsoft Office
#end if
#else
' Code is running in VBA version 6 or earlier
#end if
#If Vba7 Then
Declare PtrSafe Sub...
#Else
Declare Sub...
#EndIf
Link od MS
Aha. No ak je to tak, tak potom nie použiť StrComp(), ale definovať si reťazec českých znakov UCASE(), a použiť InStr(). Ale zatiaľ to prerábať nebudem, počkám na vyjadrenie Raptora-22.
Ja by som to videl nejako takto. Je to ale špecializované na jednostĺpcové oblasti, tak ako ste chcel.
Sub Oznac_diakritiku_v_oblasti(Oblast As Range)
Dim USlova, USpolu As String, Nahrad() As String, i As Long, UZnak As String * 1, poz As Long, Dlzka As Long, Pokracuj As Boolean, RNG As Range, Riadkov As Long
Const ODDEL = "•#$" 'Jednoznačný oddeľovač buniek
With Oblast
.ClearFormats 'Vymaže doterajší formát
Riadkov = .Cells(.Rows.Count).End(xlUp).Row - .Row + 1 'Budú sa skúmať iba vyplnené riadky
Select Case Riadkov
Case Is < 0: Exit Sub
Case Is > 1: USpolu = UCase(Join(WorksheetFunction.Transpose(Oblast), ODDEL)) 'Spojenie a prevod na UCASE
Case 1: USpolu = UCase(.Cells(1))
End Select
Nahrad = Split("A•B•C•D•E•F•G•H•I•J•K•L•M•N•O•P•Q•R•S•T•U•V•W•X•Y•Z", "•") 'Pre niektoré prípady bude možno lepšie vyradiť aj iné znaky, viď nižšie. Ale niekedy to je zase kontrproduktívne.
'Nahrad = Split("A•B•C•D•E•F•G•H•I•J•K•L•M•N•O•P•Q•R•S•T•U•V•W•X•Y•Z•0•1•2•3•4•5•6•7•8•9•+•-•*•/•=•?•!•(•)•.•_•:•;•,", "•")
For i = 0 To UBound(Nahrad) 'Vynechanie znakov
If Not InStr(USpolu, Nahrad(i)) Then USpolu = Replace(USpolu, Nahrad(i), vbNullString)
Next i
USlova = Split(USpolu, ODDEL) 'Rozdeľ naspäť prečistené
For i = 0 To UBound(USlova)
Dlzka = Len(USlova(i)) 'Zistí dĺžku reťazca, pre ukončenie
If Dlzka > 0 Then
poz = 1
Pokracuj = True
While Pokracuj
UZnak = Mid$(USlova(i), poz, 1) 'Po jednom znaku kontroluj
If StrComp(UZnak, LCase(UZnak), vbBinaryCompare) = 0 Then 'ak nenájde rozdiel medzi UCASE a LCASE znaku, nieje to určite diakritika, lebo ostatné písmená sme vyradili už skôr, a je to nejaký iný znak
poz = poz + 1
If poz > Dlzka Then Pokracuj = False 'Ak bolo posledné písmeno, ukonči
Else
Pokracuj = False
If RNG Is Nothing Then Set RNG = .Cells(i + 1) Else Set RNG = Union(RNG, .Cells(i + 1)) 'a ak nájde rozdiel medzi UCASE a LCASE znaku, je to určite diakritika, a teda priraď do výslednej oblasti
End If
Wend
End If
Next i
End With
If Not RNG Is Nothing Then RNG.Interior.Color = vbYellow 'Vyfarbiť
End Sub
Sub Oznac()
With ThisWorkbook.Worksheets("Hárok1")
Oznac_diakritiku_v_oblasti .Range("H12:H15000") '1. jednostĺpcová oblasť
Oznac_diakritiku_v_oblasti .Range("X12:X15000") '2. jednostĺpcová oblasť
End With
End Sub
EDIT:
Prípadne to "jadro pudla" - While->Wend, vymeniť za asi o 2% rýchlejší variant
While Pokracuj
UZnak = Mid$(USlova(i), poz, 1) 'Po jednom znaku kontroluj
Select Case True
Case Asc(UZnak) < 128: poz = poz + 1: Pokracuj = poz <= Dlzka 'Kontrola iba znakov >127, Ak bolo posledné písmeno, ukonči
Case StrComp(UZnak, LCase(UZnak), vbBinaryCompare) = 0: poz = poz + 1: Pokracuj = poz <= Dlzka 'ak nenájde rozdiel medzi UCASE a LCASE znaku, nieje to určite diakritika, lebo ostatné písmená sme vyradili už skôr, a je to nejaký iný znak, Ak bolo posledné písmeno, ukonči
Case Else: Pokracuj = False: If RNG Is Nothing Then Set RNG = .Cells(i + 1) Else Set RNG = Union(RNG, .Cells(i + 1)) 'a ak nájde rozdiel medzi UCASE a LCASE znaku, je to určite diakritika, a teda priraď do výslednej oblasti
End Select
Wend
a)
V SK/EN:
FIND() alebo SEARCH()
V CZ:
NAJÍT() alebo HLEDAT()
b)
V SK/EN:
LEFT()
V CZ:
ZLEVA()
Použitie triviálne, viď nápoveda.
Asi skúste ten zdieľaný zošit. Makrom to totiž vôbec nebude také jednoduché ako sa na prvý pohľad zdá.
-Môže nastať zmena viacerých buniek (aj nesúvislých), nielen 1 bunky. Na to sa vyššie uvedený kód nedá použiť. Teraz je otázne, či to urobiť ako logovanie úrovne Areas (+ spojiť všetky hodnoty do oddeleného reťazca) alebo Cells, čo je pri obľube mazania celých stĺpcov nereálne.
-A čo vymazanie pridanie riadku ? Teda sa musí pri každej zmene kontrolovať aj počet riadkov. Ak sa pridá alebo zmaže celý riadok, nastane zmena, kde Target bude počet stĺpcov Excelu, tak sa dá určiť, či bol pridaný/vymazaný riadok. Samotná identifikácia pridania či zmazania sa potom musí urobiť na základe počtu riadkov. Lenže riadky sa dajú pridať aj vložením a posunutím iba niektorých buniek. Celé sa to komplikuje.
-Najväčšia komplikácia ale je, ako zistiť pôvodnú hodnotu. Buď sa bude uchovávať rovnaký list ako skrytý, alebo sa po každej zmene použije Undo, prečítajú sa hodnoty podľa Target, a použije sa Redo. To je katastrofálne pomalé. A ešte pomalšie je, uchovávanie predošlých hodnôt v druhom liste. Prečo? Lebo musíte najskôr identifikovať čo sa udialo (viď napr. pridanie riadku) a následne urobiť to isté v skrytom liste po prečítaní predošlých hodnôt. A to môže byť pre niektoré veci nezrealizovateľné. Napr. pridanie či aplikovanie filtra nevyvolá akciu zmeny, a pritom môže mať enormný dopad na výsledok.
Atď. Snáď sa mýlim, ale nevidím tu reálnu cestu makrom ak nevieme ani či sa jedná a uzavretú tabuľku bez možnosti pridania/vymazania riadku/stĺpca, vplyvu filtrov, či zmeny iných objektov, ...
Tolerancia väčšinou znamená, že aj krajné hodnoty platia, teda Vám tu už spomínali, aby ste si tam dali >= a <=, nielen < a >, tak ako písal "xlnc".
Prehodte "vyhovuje" zo svojho vzorca tak ako to napísal "veny".
Ak sú Min a Max pre viac riadkov použite absolútne adresovanie. Všetko tu už máte napísané.
=IF(AND(J10>=$L$10;K10<=$M$10);"vyhovuje";"nevyhovuje")
=KDYŽ(A(J10>=$L$10;K10<=$M$10);"vyhovuje";"nevyhovuje")
EDIT:
A ešte niečo, Vy potrebujete skontrolovať :
a.) aby boli obe hodnoty J10 aj K10 v tolerancii ? Teda obidve zvlášť voči Maximu aj Minimu ?
b.) kontrolovať J10 voči Minimu, a K10 voči Maximu ? Teda keď bude K10 pod Minimom, to nevadí ?
Sub SmazatPosledniRadek()
Dim PoslRadek As Long
With ThisWorkbook.Worksheets("Tabulka")
PoslRadek = .Cells(Rows.Count, 1).End(xlUp).Row
'If PoslRadek > 1 Then .Cells(PoslRadek, 1).Resize(, 7).Delete Shift:=xlUp
If PoslRadek > 1 Then .Cells(PoslRadek, 1).EntireRow.Delete
End With
End Sub
Použite jeden alebo druhý riadok "If ...", podľa toho, či sa má zmazať celý Excelácky riadok, alebo iba riadok tabuľky (teda či má vpravo od tabuľky všetko ostať alebo nie, teda ak tam niečo je).
EDIT:
Prípadne
If PoslRadek > 1 Then .Cells(PoslRadek, 1).Resize(, 7).Clear
alebo
If PoslRadek > 1 Then .Cells(PoslRadek, 1).Resize(, 7).ClearContents
Záleží na tom, čo myslíte pod slovom "vymazať", a čo pod pojmom "tabuľka".
Príklad možnosti presunu označených riadkov (označenie v hociktorom stĺpci z A:D v rozsahu vyplnených údajov). Je to cez tlačítko, lebo klik na bunku (výber bunky) mi príde zlý nápad.
Skúste:
=INDEX(Hárok2!A:A;(ROW(A1)-1)*6+1)+SUM(OFFSET(Hárok2!$A$1;(ROW(A1)-1)*6+1;;2))*2
=INDEX(Hárok2!A:A;(ŘÁDEK(A1)-1)*6+1)+SUMA(POSUN(Hárok2!$A$1;(ŘÁDEK(A1)-1)*6+1;;2))*2
Načo je tam to "Ano" v A1 ?
Počítate určite hodnoty od A1 ? Nie náhodou až od B1 ?
Načo slúži v makre Dim AnoNe() ?
Ak si ujasníte absolútne a relatívne adresovanie buniek, nepotrebujete podľa mňa žiadny cyklus.
Napr.
Sub pokus()
With Range(Cells(2, 1), Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0))
.Formula = "=COUNTIFS(WINS!$R:$R,A$1,WINS!$S:$S,B$1)"
.Value = .Value
End With
End Sub
Nechce sa mi premýšľať nad všetkým, čo sa tu už popísalo, tak len uvediem pokus na tej prílohe. Keď si dám
WorksheetFunction.VLookup(Vztah * 1, Seznam, 2, 0)
alebo
WorksheetFunction.VLookup(Val(Vztah), Seznam, 2, 0)
tak to fičí.
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články