Příspěvky uživatele

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

Máte tam už vzorce, a chcete ich nahradiť hodnotami ?
Označte oblasť, Ctrl+C, pklik, Možnosti prilepenia - Hodnoty. Na to nieje treba makro.

Nemáte tam vzorce, a chcete ich vložiť do stĺpca A:A toľko, koľko je v riadku 2:2 hodnôt, a následne previesť na hodnoty ? Na to sa dá makro urobiť, ale vložte prílohu ako to vyzerá, nech vieme ako sú dáta umiestnené, odsadené, typ dát, či je pod tabuľkou niečo iné na čo treba brať ohľad pri zisťovaní počtu riadkov, či sú tam medzery a pod ...

A toto by nešlo ?
Sub NajdiOznac()
Dim PocetU As Long, PocetSD As Long, V, RNG As Range

PocetSD = Sheets("Strategické díly").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Urgence")
PocetU = .Cells(Rows.Count, 3).End(xlUp).Row

If PocetU = 1 Or PocetSD = 2 Then MsgBox "Není co řešit :)": Exit Sub
V = Evaluate("=IF(COUNTIF('Strategické díly'!A3:A" & PocetSD & ",Urgence!C2:C" & PocetU & ")>0,True)")

For PocetU = 1 To PocetU - 1
If V(PocetU, 1) Then
If RNG Is Nothing Then Set RNG = .Cells(PocetU + 1, 3) Else Set RNG = Union(RNG, .Cells(PocetU + 1, 3))
End If
Next PocetU
End With

If Not RNG Is Nothing Then RNG.Interior.Color = RGB(0, 255, 0)
End Sub

Sub NajdiReklamace()
Dim rngPrvni As Range, rngPosledni As Range, rngReklamace As Range
With Range("N:N")
Do
If rngPrvni Is Nothing Then
Set rngPrvni = .Find(What:="EBE", After:=.Cells(1), LookAt:=xlPart)
Set rngPosledni = rngPrvni
Else
Set rngPosledni = .Find(What:="EBE", After:=rngPosledni, LookAt:=xlPart)
If rngPosledni.Address = rngPrvni.Address Then Exit Do
End If
If rngPosledni Is Nothing Then Exit Do
If rngReklamace Is Nothing Then Set rngReklamace = rngPosledni.Offset(0, 5) Else Set rngReklamace = Union(rngReklamace, rngPosledni.Offset(0, 5))
Loop
End With
If Not rngReklamace Is Nothing Then rngReklamace = "REKLAMACE"
End Sub

Áno drobná chybka odo mňa pri $D$4 má byť $D4, samozrejme. Pridal som Vám tam vizuálne overenie, a ejhľa. Nielenže Vám nesedia tie hodnoty čo tam máte uvedené v rozsahoch voči meradlám, ale navyše tam máte medzery okolo "-", pričom v zoznamoch medzery niesú. To som upravil. Rovnako pozor na to, že som Vám, tak ako ste chcel, vypustil tie podtržítka.

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje