Příspěvky uživatele

=KEĎ(N10="";"";KEĎ(N10>=ČAS(4;0;0);N10-I10;N10))

Doplň si ešte do Ciferníka dákum 1.1.2027 inak ti nebude rátať prechod medzi 2026/2027 ak by niekto robil nočnú.

Keď budeš robiť ďalší príplatok (napr. „nočná + sviatok“ alebo „SO+NE v noci“), vždy rieš prienik časových intervalov, nie „deň smeny“. Presne týmto spôsobom.

připrav si...

Datum směny (např. B2)
Začátek (např. E2)
Konec (např. F2)

Seznam svátků v jednom sloupci (např. na listu Číselníky v A:A) a ideálně pojmenovaný rozsah Svatky.

Tento vzorec ti vrátí kolik času ze směny padá do svátku (formátuj jako [h]:mm)

=LET(
Start; B2+E2;
End; B2+F2 + KDYŽ(F2<E2;1;0);
d0; INT(Start);
d1; INT(End);

JeSvat0; JE.ČÍSLO(XLOOKUP(d0;Svatky;Svatky;""));
JeSvat1; JE.ČÍSLO(XLOOKUP(d1;Svatky;Svatky;""));

Prunik; LAMBDA(d; MAX(0; MIN(End; d+1) - MAX(Start; d)));

JeSvat0*Prunik(d0) + JeSvat1*Prunik(d1)
)

Nejlepší fix s nejvyšší spolehlivostí bez Range.CopyPicture

Ty už primárně hledáš Shape na řádku (obrázek v B sloupci). Tak to využij a exportuj Shape do PNG a pak ho vlož jako obrázek. Tím úplně obejdeš clipboard a CopyPicture.

Shape - PNG - vložit do náhledu

Výhoda: funguje stabilně i když list není aktivní, žádné 1004 z CopyPicture.

Public Sub DisplayPreview(prefix As String, ID As Long)
Dim wsMap As Worksheet: Set wsMap = ThisWorkbook.Sheets(MapSheetName)
Dim wsList As Worksheet: Set wsList = ThisWorkbook.Sheets(GetListName(prefix))
Dim foundCell As Range, dataRow As Long
Dim shpCandidate As Shape, srcShape As Shape
Dim areaR As Range
Dim previewShape As Shape
Dim origW As Double, origH As Double, scaleRatio As Double
Dim tmpPng As String

On Error GoTo CleanFail

Application.ScreenUpdating = False
Application.EnableEvents = False

LastPrefix = prefix
LastID = ID
Set areaR = wsMap.Range(PreviewAreaRange)

' Najdi řádek podle ID
With wsList.Columns("A")
Set foundCell = .Find(What:=CStr(ID), LookIn:=xlValues, LookAt:=xlWhole)
If foundCell Is Nothing Then GoTo CleanExit
dataRow = foundCell.Row
End With

' Smazat starý náhled
On Error Resume Next
wsMap.Shapes("PreviewPic").Delete
On Error GoTo CleanFail

' Najdi obrázek (Shape) v buňce B na daném řádku
Set srcShape = Nothing
For Each shpCandidate In wsList.Shapes
If shpCandidate.TopLeftCell.Row = dataRow And shpCandidate.TopLeftCell.Column = 2 Then
Set srcShape = shpCandidate
Exit For
End If
Next shpCandidate

If srcShape Is Nothing Then
' Pokud nemáš Shape, tak aspoň fallback na text/desc a konec
wsMap.Range(PreviewDescName).Value = wsList.Range("C" & dataRow).Value
GoTo CleanExit
End If

' Export shape do PNG (TEMP)
tmpPng = Environ$("TEMP") & "\PreviewPic_" & prefix & "_" & CStr(ID) & ".png"
On Error Resume Next
Kill tmpPng
On Error GoTo CleanFail
srcShape.Export Filename:=tmpPng, FilterName:="PNG"

' Vložit PNG do map sheetu jako picture/shape
Set previewShape = wsMap.Shapes.AddPicture( _
Filename:=tmpPng, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=areaR.Left, Top:=areaR.Top, Width:=-1, Height:=-1)

previewShape.Name = "PreviewPic"

' Scale + centrování do PreviewArea
origW = previewShape.Width: origH = previewShape.Height
scaleRatio = Application.Min(areaR.Width / origW, areaR.Height / origH)

With previewShape
.LockAspectRatio = msoTrue
.Width = origW * scaleRatio
.Height = origH * scaleRatio
.Left = areaR.Left + (areaR.Width - .Width) / 2
.Top = areaR.Top + (areaR.Height - .Height) / 2
End With

' Popisek
wsMap.Range(PreviewDescName).Value = wsList.Range("C" & dataRow).Value

CleanExit:
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub

CleanFail:
' Když něco selže, radši se vrať do konzistentního stavu
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
' volitelně: Debug.Print Err.Number, Err.Description
End Sub

Rubberduck VBA (VBE add-in)

-statické analýzy (inspections) a vie nájsť aj veľa „mŕtveho“/podozrivého kódu,
-veľmi dobrá navigácia a „Find references“ (to je základ pre mapovanie previazaní),
-refactoring, unit testy, Code Explorer atď.

Tu je link :
https://rubberduck-vba.github.io/Rubberduck/GettingStarted.html?utm_source=chatgpt.com

Áno, je to možné. Bez VBA nie.
Ak chceš jedny globálne dátumy Od/Do, ktoré okamžite prefiltrujú 6 listov naraz, najlepší a technicky čistý spôsob je centrálny filter + VBA.

Na každom z 6 listov:

máš tabuľku (ListObject) alebo aspoň rozsah

stĺpec s dátumom je rovnaký názov / rovnaký index (napr. stĺpec „Dátum“)

Ak nemáš rovnaký stĺpec dátumu → najprv to zjednoť.

Vytvor „riadiaci“ list

Napr. list FILTER:

B2 = Dátum OD

B3 = Dátum DO

Tieto bunky budú jediný zdroj pravdy.

Toto vlož do ThisWorkbook:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "FILTER" Then Exit Sub
If Intersect(Target, Sh.Range("B2:B3")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Call ApplyDateFilterToAllSheets
Application.EnableEvents = True
End Sub

(Module1)
Sub ApplyDateFilterToAllSheets()
Dim ws As Worksheet
Dim dtFrom As Date, dtTo As Date
Dim lo As ListObject
Dim colIndex As Long

dtFrom = Sheets("FILTER").Range("B2").Value
dtTo = Sheets("FILTER").Range("B3").Value

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "FILTER" Then
If ws.ListObjects.Count > 0 Then
Set lo = ws.ListObjects(1) ' ak máš na liste 1 tabuľku

' Nájdi stĺpec "Dátum"
colIndex = lo.ListColumns("Dátum").Index

With lo.Range
.AutoFilter Field:=colIndex, _
Criteria1:=">=" & CLng(dtFrom), _
Operator:=xlAnd, _
Criteria2:="<=" & CLng(dtTo)
End With
End If
End If
Next ws
End Sub

Kurňajs :D ďakujem ti

Zdravím Vás, neviem si trocha rady. Tak sa obraciam na Vás.

Systém mi po stiahnutí generuje takýto zoznam, viac v prílohe. V stĺpci A je názov stojana a ďalší záznam o opravách. Potrebujem s danej tabuľky urobiť kontingenčné. Mám Dátum ukončenia a kus... Potrebujem nejak docieliť aby sa názov stojana v stĺpci A nakopíroval až po posledný voľný riadok nasledujúceho stojana. Následne ďalší názov stojana. Keby to nebolo cez 5000 riadkov tak to ani neriešim.

Ďakujem za každú radu.

Ahojte,

Snažím sa nájsť riešenie na môj problém.
Riešil by som to cez kontingenčnú tabuľku ale v tomto prípade to neprichádza do úvahy.

List prehľad:
V stĺpci A mam ID produktu v B počet objednaného tovaru a C objednávku.

List objednácky:

Stĺpec A ID v B počet objednaného tovaru a C objednávku.
ID sa tu nachádza viac krát podľa toho koľko razí bol objednaný tovar.

Priradenie počtu objednaných kusov k ID nie je problem.

A tu nastáva problém, potreboval by som k danému id do stĺpca C priradiť vsetky vystavené objednávky do jednej bunky.

Je to vobec reálne ?

Zdravím, vedeli by ste mi poradit. V prvom liste stlpec A mam kody produktu. V druhom liste objednavky podla kodu produktu. A. Kod pr, B. objednavka, C. mnozstvo. Potreboval by som zlucit do prveho listu podla kodu objednavky. Problem nastava ak mam viac objednavok na jeden kod produktu. Spocitat mnozstvo do jednej bunky nie je problem ale ako dostat 2.3 objednavky do jednej bunky za kod produktu?

Budem vďačný za kazdu radu.

Príloha

Zdravim, Tabulka je A az K, data sa stale pridavaju. Formatovanie nieje potrebne len copy paste

Zdravím, potreboval by som poradiť.

Mám asi 5 listov v ktorých je vždy rovnaká tabuľka. V stĺpci K je uložená hodnota 1 alebo nula. Potreboval by som do listu dada skopírovať riadky ktoré na konci obsahujú hodnotu 1.

Dík za pomoc.

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje