Příspěvky uživatele


< návrat zpět

Strana:  1 2 3 4 5 6 7 8 9   další » ... 140

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 ... 1

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čí.

Jáj :)

Ale okrem zámeny "řádku A:A" s "sloupcem A:A" mi tam do očí bije ešte to, že treba vkladať vzorce do A1, A2, A3, ... na základe riadku 2:2. Čo ale koliduje s vkladaním do A2, keďže je to 1. bunka 2. riadku, ktorý je referenčný pre počet vzorcov.

Alebo podľa druhého príspevku je vraj v sloupci A:A v bunke A1 vzorec X, v bunke B1 vzorec Y, ... Lenže problém je, že bunka B1 nieje v sloupci A:A.

No a do tretice mi neštimuje v B1 vzorec =COUNTIFS(wins!S:S;$C$1;wins!S:S;$B$1), ktorý odkazuje ako kritérium sám na seba, teda B1. A rovnaké to bude v bunke C1 keď bude zase prvé kritérium C1.

Teda ja predpokladám, že keď si dopletiete tie jablkohrušky, tak nám ukážete niečo v tom zmysle, že máte v riadku 2:2 (A2:Axxx) hodnoty, ktoré určujú počet vzorcov v riadku 1:1 (A1:Axxx). A tie vzorce do 1:1 (A1:Axxx) chcete vložiť, pričom ako kritérium bude odpovedajúca hodnota napr. z 2:2 (A2:Axxx). A pod. Proste niečo, čo nebude kolidovať navzájom. :)

Takže Dejwing, šup sem prílohu...


Strana:  1 2 3 4 5 6 7 8 9   další » ... 140

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Zaokruhlenie na 15min

Jirka100 • 22.7. 11:24

VBA - zapsaní jména před uložením

Stalker • 21.7. 23:57

Makro - vytváření historie

Merlin99 • 21.7. 16:33

Makro - vytváření historie

Stalker • 21.7. 16:20

Makro - vytváření historie

Merlin99 • 21.7. 15:48

Makro - vytváření historie

Stalker • 21.7. 13:50

Makro - vytváření historie

Merlin99 • 21.7. 12:47