• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Napadla ma aj možnosť bez makra. OneClick riešenie. Iba pre aktualizáciu kliknete na "Viditeľné". Radí to vzorcom. A potom tlačíte. Tu je ale problém, že z tlačiarne vyjdú prázdne strany na tabuľkách, ktoré neobsahujú dáta. Sú síce neviditeľné, ale sú tam pevné zlomy strán :(
Nenapadá ma riešenie tohto neduhu, lebo vypočítavaná oblasť tlače nemá v Exceli spoľahlivú životnosť (prepíše ju o chvíľu natvrdo). A ak by sa to urobilo aj cez PowerQuery, alebo plus kontingenčka, nedostanete Vaše rozloženie a formátovanie. Lebo vždy sa dostanete do bodu tlače, keď nebudú sedieť zlomy, výška hlavičky, umiestnenie kategórie...

Napadá niekoho niečo?

Asi fakt jedine makrom...

PS: Odhesloval som si to, a následne zahesloval, list s heslom zmazal, všetky makrá tiež.

Maticový vzorec (Ctrl+Shift+Enter):
=INDEX(Ceník!$C$2:$C$8;MATCH(1;(Ceník!$A$2:$A$8=A2)*(Ceník!$B$2:$B$8=B2);0))
=INDEX(Ceník!$C$2:$C$8;POZVYHLEDAT(1;(Ceník!$A$2:$A$8=A2)*(Ceník!$B$2:$B$8=B2);0))
alebo normálny, ale iba pre prípad, že sú zoskupené IČ aj Kódy:
=INDEX(Ceník!$C$2:$C$8;MATCH(B2;OFFSET(Ceník!$B$1;MATCH(A2;Ceník!$A$2:$A$8;0);;COUNTIF(Ceník!$A$2:$A$8;A2));0)+MATCH(A2;Ceník!$A$2:$A$8;0)-1)
=INDEX(Ceník!$C$2:$C$8;POZVYHLEDAT(B2;POSUN(Ceník!$B$1;POZVYHLEDAT(A2;Ceník!$A$2:$A$8;0);;COUNTIF(Ceník!$A$2:$A$8;A2));0)+POZVYHLEDAT(A2;Ceník!$A$2:$A$8;0)-1)
EDIT:
Ešte ma napadol jeden normálny nematicový, keď nemusia byť zoskupené, ale musí byť dodržané, že IČ a Kód nie sú nikdy rovnaké, a dvojica sa v cenníku vyskytuje iba 1x:
=INDEX(Ceník!$C$2:$C$8;MATCH(2;MMULT(COUNTIF($A2:$B2;Ceník!$A$2:$B$8);{1;1});0))
=INDEX(Ceník!$C$2:$C$8;POZVYHLEDAT(2;SOUČIN.MATIC(COUNTIF($A2:$B2;Ceník!$A$2:$B$8);{1;1});0))

Vlastnosť UserForm-u
ShowModal = False

=INDEX(Ceník!$B$1:$H$1;;MATCH(B2;OFFSET(Ceník!$B$1:$H$1;MATCH(A2;Ceník!$A$2:$A$8;0););0))
=INDEX(Ceník!$B$1:$H$1;;POZVYHLEDAT(B2;POSUN(Ceník!$B$1:$H$1;POZVYHLEDAT(A2;Ceník!$A$2:$A$8;0););0))

Prípadne o kúsok kratší:
=LOOKUP(B2;OFFSET(Ceník!$B$1:$H$1;MATCH(A2;Ceník!$A$2:$A$8;0););Ceník!$B$1:$H$1)
=VYHLEDAT(B2;POSUN(Ceník!$B$1:$H$1;POZVYHLEDAT(A2;Ceník!$A$2:$A$8;0););Ceník!$B$1:$H$1)

Ja neviem chlapi. Napadlo ma takéto UDF. Vyznačil som tam jednu chybu, ktorú neviem eliminovať. Skúste:
Public Function GET_ANIMALS(Text As String, Mesto As String) As String
Dim S() As String, C() As String, i As Long, x As Long, PocetC As Long, PocetS As Long, bValidA As Boolean

S = Split(WorksheetFunction.Trim(Text), WorksheetFunction.Trim(Mesto) & ": ")
If UBound(S) = 0 Then Exit Function
S = Split(Split(S(1), ": ")(0), " a ")
PocetS = -1

For i = 0 To UBound(S)
C = Split(S(i), " ")
PocetC = -1
bValidA = False

For x = 0 To UBound(C) Step 2
If x + 1 <= UBound(C) Then
bValidA = (IsNumeric(Left(C(x), 1)) And Not IsNumeric(Left(C(x + 1), 1))) Or (Not IsNumeric(Left(C(x), 1)) And IsNumeric(Left(C(x + 1), 1)))
Else
bValidA = False
End If

If bValidA Then
PocetC = x + 1
Else
If PocetC = -1 Then PocetC = 0
Exit For
End If
Next x

If PocetC > -1 Then
ReDim Preserve C(PocetC)
S(i) = Join(C, " ")
PocetS = PocetS + 1
Else
Exit For
End If
Next i

If PocetS > -1 Then
ReDim Preserve S(PocetS)
GET_ANIMALS = Join(S, " a ")
End If
End Function

To ja som opačne. Kedysi čierne kučery, dnes rovný sivovlas
No a tie data - čumím na to ako Ďuro do makových slížov, a nevidím žiadnu "schému", ktorá by sa dala spoľahlivo dešifrovať. Rozdeliť cez ":" nie je prob. Ten nastane keď nevieme od seba rozlíšiť 2 druhy ostatných údajov. Ani medzerou, ani číslom, ani číslom spolu s "x" (raz pred, raz za), ani veľké/malé písmeno, nič...

Pozrite na prílohu. Také jednoduché to nieje. Môže nastať viac situácií, na ktoré treba pri tom PF myslieť. Napr. je to prvý mesiac (žiadny mu nepredchádza), nejaký mu predchádza, prenáša sa nejaký počet dní alebo žiadne, COUNTIF na OFFSET treba podmieniť, a OFFSET treba ošetriť kvôli chybám, a prípadnej nesprávnej oblasti. Bolo potrebné riešiť CZ názvy listov. Zobrazujú sa iba korektné dni daného mesiaca. Urobil som Vám aj sviatky. Hrubá čiarka pred "T" bežne cez PF nejde. A pod...

Takto???
=7-(EOMONTH($A$1;0)-LOOKUP(2;1/(D3:AH3="T");$D$2:$AH$2)+1)
=7-(EOMONTH($A$1;0)-VYHLEDAT(2;1/(D3:AH3="T");$D$2:$AH$2)+1)

Prípadne celé takto, v prílohe.

pr.:
Sub ColoringText()
Dim myRange As Range, D()
Dim substr As String, endstr As String
Dim txtColor As Long, x As Long, y As Long, Pos As Long, endPos As Long, startPos As Long, LenEndStr As Long

Set myRange = Worksheets("Hárok1").Range("A1:A100")
If myRange.Cells.Count > 1 Then D = myRange.Value Else ReDim D(1, 1): D(1, 1) = myRange.Value

substr = "Nezapsané prostoje-"
endstr = "min"
txtColor = 3
LenEndStr = Len(endstr)

For y = 1 To UBound(D, 1)
For x = 1 To UBound(D, 2)
Pos = 1
Do
startPos = InStr(Pos, D(y, x), substr, vbTextCompare)
If startPos <> 0 Then
endPos = InStr(startPos, D(y, x), endstr, vbTextCompare)
If endPos <> 0 Then
myRange.Cells(y, x).Characters(Start:=startPos, Length:=endPos - startPos + LenEndStr).Font.ColorIndex = txtColor
Pos = endPos + LenEndStr
End If
End If
Loop Until startPos = 0 Or endPos = 0
Next x
Next y
End Sub

@ Jiří497 : Tiež ste si všimol, že jedna veta je po slovensky a druhá po česky?

Skúste toto. Neodlaďoval som, ale ak je to na prvú správne, tak neverím, že to bude trvať dlhšie ako 0,5 sek.
Sub DelDup2()
Dim D(), V(), R As Long, RV As Long, i As Long, s As Long, Col As New Collection, Kopiruj As Boolean

With List1
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then MsgBox "No data!", vbExclamation: Exit Sub
D = .Range("A2:Z2").Resize(R).Value
ReDim V(1 To R, 1 To 26)
End With

For i = 1 To R
If IsNumeric(D(i, 9)) Then
On Error Resume Next
Col.Add RV + 1, CStr(D(i, 9))
Kopiruj = Err.Number = 0
On Error GoTo 0
Else
Kopiruj = True
End If

If Kopiruj Then
RV = RV + 1
For s = 1 To 26
V(RV, s) = D(i, s)
Next s
Else
s = Col(CStr(D(i, 9)))
V(s, 6) = V(s, 6) + D(i, 6)
End If
Next i

With List2
Intersect(.Range("A:Z"), .UsedRange.Offset(1, 0).EntireRow).ClearContents
.Cells(2, 1).Resize(R, 26).Value = V
End With
End Sub

Čo je to za program? Priznám sa, že mne sa konkrétne toto skúmať nechce, ale ak by sa niekomu chcelo, info o programe mu určo bodne

Skúste pohľadať niečo ako "Java Portable". Napr. tento prvý odkaz na Google.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse