Příspěvky uživatele

Dim bDISABLE_CLICK As Boolean
Private Sub CheckBox1_Click()
If bDISABLE_CLICK Then Exit Sub
bDISABLE_CLICK = True
If Not CheckBox1.Value Then
If MsgBox("Při vypnutí budou zůstávat všechny hodnoty stále vyplněny. Pokračovat?", vbYesNo + vbExclamation, "Varování!") = vbNo Then CheckBox1.Value = True: GoTo KONEC_CLICK
Else
If MsgBox("Při zapnutí dojde k vynulování všech uložených hodnot. Pokračovat?", vbYesNo + vbExclamation, "Varování!") = vbNo Then CheckBox1.Value = False: GoTo KONEC_CLICK
Reset
End If
KONEC_CLICK:
bDISABLE_CLICK = False
End Sub

Je možnosť použiť a featurku EVALUATE a funkciu volanú z bunky. Má to jednu výhodu, že Vám dovolí 1x Undo.
Function RGBCOLOR(RNG As Range, R As Range, G As Range, B As Range) As Variant
Application.Volatile
Evaluate "RGBEVAL(""" & RNG.Address(1, 1, 1, 1) & """," & rgb(R.Value, G.Value, B.Value) & ")"
End Function
Sub RGBEVAL(RNG As String, colRGB As Double)
Range(RNG).Interior.Color = colRGB
End Sub

Nemôžete dať nejakú prílohu, ako to konkrétne vyzerá? Od ktorého riadku (kde je hlavička, a kde začínajú data), všetky listy rovnako? Sú použité filtre (všetky listy rovnako)? Sú to tabuľky alebo Tabuľky? Rozsah údajov sa dá zistiť podľa ktorých smerodatných stĺpcov? V D sa teda môžu nachádzať len a len 2 údaje (opakované mnohokrát, ale len 2)? Ak všetky listy splnia podmienku, bude 1 hláška "OK", alebo pre každý list má byť hláška samostatná? Je nutné nejaký list ignorovať (je nejaký list v zošite "nedátový", napr. Zoznamy, Adresár, Nastavenie, Temp, prázdny report ...)?

Súbor - Možnosti - Rozšírené - Povoliť rukoväť výplne a presúvanie buniek

Tak takéto hrátky s kopírovaním multiriadkov fungujú iba v Exceli. Do inej apky to nejde. Jediné riešenie, čo ma napadá, je použiť skrytý dočasný TMP list.
Sub Makro1() ' Klávesová skratka: Ctrl+g
Dim RNG As Range

Set RNG = ActiveSheet.Range("C4:F4")
wsTMP.UsedRange.Clear
On Error Resume Next
Union(Intersect(Intersect(Selection, RNG.Offset(1, 0).Resize(Rows.Count - RNG.Row)).EntireRow, RNG.EntireColumn), RNG).Copy wsTMP.Cells(1, 1)
If Err.Number = 0 Then wsTMP.UsedRange.Copy Else MsgBox "Nevybrali jste řádky od č. " & RNG.Row + 1 & " ve sloupcích " & RNG.EntireColumn.Address(0, 0), vbCritical
End Sub

Makro sa dá urobiť veľmi rýchle. Používate strašne pomalý postup - z bunky do bunky a ešte ich aj označujete. Treba to prerobiť do polí. Na prvý pohľad nevidím nejaké komplikácie, prečo by to malo ísť po prerobení pomaly. Niektoré veci sú tam doslova zbytočné, napr. cyklus v "Najdi" podľa mňa len spomaľuje. Uvidím podľa času, ale takéto niečo to musí fičať...
Pomaly to začnem analyzovať, tak dúfam, že to nepotrebujete do Vianoc, páč mám roboty jak nasranej...

Ale žijem. Snáď. Len som bol chorý, potom som na to zabudol, a včuleky som chorý zase. Pamätám si, že som si myslel, že mám spôsob ako zistiť, či je súbor UTF-8 alebo ANSI, bez otvárania súboru v Exceli, ale nefachá to. Čo bolo cieľom, kvôli rýchlosti. No musím to po večoroch ešte pohľadať, kde to mám rozrobené... a prípadne to prekopať na klasické otváranie v Exceli (alebo PowerQuery, lebo neviem už čo to presne bolo).

Ja tam slovo "Hodnota" nemám

Zase logické hádanky...

Takže vy vždy načítate šesticu (skupinu) riadkov a zapíšete ju za posledný riadok v A? Alebo tie šestice sú iba ako príklad možných dát v A, a v skutočnosti sa prepisuje vždy A od bunky $A$1?

Ak platí prvá možnosť, tak to, čo sa má hľadať v ďalších bunkách šestice (riadky 2-6), sa nachádza vždy v 1. bunke šestice? Alebo je hľadaná hodnota vždy v $A$1 a nezáleží na tom, čo je v 1. bunke šestice? Alebo má každá 1. bunka každej šestice vždy hodnotu z $A$1?

Vy teda neviete v ktorom z riadkov 2-6 sa bude nachádzať >11 znakov? Farba zelená/červená sa má aplikovať iba na riadky, ktoré majú >11 znakov, a to podľa toho či obsahujú hľadanú hodnotu. Ostatné bunky v šestici s <11 znakmi nevyfarbovať. Je tak?

Popis a príklady sú nejednoznačné.

PS: Použitie makra zruší Undo.

Vzorec od Lugr by som upravil na variabilné mesiace a roky ($I$1 je rok, H3...x je číslo mesiaca):
=SUMIFS($C$3:$C$703;$B$3:$B$703;">="&DATE($I$1;H3;1);$B$3:$B$703;"<="&EOMONTH(DATE($I$1;H3;1);0))
=SUMIFS($C$3:$C$703;$B$3:$B$703;">="&DATUM($I$1;H3;1);$B$3:$B$703;"<="&EOMONTH(DATUM($I$1;H3;1);0))

Nie je to príliš zložité?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
Range("C1").Value = WorksheetFunction.Max(Range("C1").Value - Range("B1").Value, 0)
End If
End Sub

Nazdar kluci. Ako ste sa tu mali?
To je podľa zápisu evidentne úryvok z môjho kódu. O čo tam konkrétne šlo? Ktorá je pôvodná téma? Čo obsahuje ten dolovací vzorec v premennej "Vzorec"? Príloha?

Ale má to riešenie, čoby nie. Nemal som na to čas. Každopádne testujem riešenie, kedy sito samé zistí UTF-8 alebo ANSI a podľa toho nastaví Charset na správne načítanie. Lenže dnes mi prestala fungovať identifikácia UTF-8. Zatiaľ v obmedzenom čase skúmam prečo.

Ešte podotázka: To nahradenie toho textu za iný sa dá aplikovať skutočne na celý súbor? Nie je možné, že ten text, ktorý sa bude nahradzovať, bude aj v iných stĺpcoch ako R:S (metaTitle:cs a metaTitle:en)?

Najlepšie by bolo tie súbory CSV v Exceli neotvárať. Obsahujú tie CSV aj diakritiku? Ak nie, tak sa to dá riešiť expresne rýchlo cez textové funkcie priamo z/do CSV. Ak áno, tak to je problém, keďže VBA má problém pri načítaní/ukladaní diakritiky vkódovaní utf-8/ansi. Zdroj je utf-8 a dáta sú ansi. Stiahnite si NotePad++ v ňom otvorte origo Zdroj aj origo dátový a pozrite vpravo dole, čo tam píše. Dá sa to ošetriť cez ADO.Stream ale treba vedieť kódovanie vopred. Má za to, že rôznosť kódovania vznikla Vašou úpravou pri anonymizovaní príloh. Myslím, že to mám z časti už pripravené, ešte počkám čo napíšete, a podľa toho sa ešte raz pokúsim pochopiť či chcete naozaj nahradiť "název1" za "názevXXX", alebo je XXX nejaká premenná a pod.

Inak aký název v prílohe Zdroj?

Ach áno, pri tvorbe riadkov jedinečných hodnôt a ich súčtov som zabudol ešte raz použiť podmienku VADA="Rozbité".

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje