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

Příspěvky uživatele

@Alfan: Bol by som odpovedal, ale v práci nám spadol internet. Každopádne, jeden záver mám, neber to zle. Dotaz si vzniesol na obed a ani po 5 a pol hodine si na to neprišiel sám? Pokiaľ sa chceš naozaj niečo naučiť, tak vlasné skúšanie ťa posunie ďalej, než čakanie na odpoveď na každú otázku.
Na druhej strane, aspoň dáš nejakú spätnú väzbu, čo na tomto fóre rozhodne nie je pravidlom.

Bez prílohy budeš na odpoveď čakať asi ešte nejakých ďalších pár hodín.

Toto nefunguje?

=MIN([Book2]Sheet1!$B:$B; [Book3]Sheet1!$B:$B; [Book4]Sheet1!$B:$B)

Nájdeš dva rozdiely?

"H:\_sklad_polozky\"

H:\_sklad_polozky\

Ono vlastne ani nie je nutné držať tie obrázky v zdrojovej tabuľke na liste data, modifikáciu riešenia od Jezy sa to dá urobiť i takto (položky v KT sa tvária ako hyperlinky, ale nie sú hyperlinkami, podtrhnutie písma má len naznačiť, kam sa má klikať). Cestu k obrázkom si musíš opraviť v module. Obrázky som v zipe neprikladal, použil som tie od Jezy. To ošetrenie chýb je už na tebe, chvíľu som sa s tým bavil a už sa mi to ďalej ladiť nechce.

Mám za to, že na riešení od kolegu môžeš stavať. V liste 4 stačí vytvoriť mapovaciu tabuľku s dvomi stĺpcami: Názov(položky) a Názov súboru s obrázkom. Na liste data v stĺpci url si dotiahneš k položke názov obrázku. Celú cestu k obrázku si nastavíš v Module2. Chce to trochu sa snažiť i sám.

V poslednom riešení som uvažoval s maximálnym počtom farbičiek 50, čo ale nie vždy musí postačovať, v iných prípadoch je to zas zbytočne mnoho. V novej verzii kódu je spočítaný potrebný počet farieb a až na základe neho stanovená veľkosť poľa clrArr. Tento kód už asi občas použijem i ja sám pre svoje vlastné potreby. Pokiaĺ bude potrebných viac než 256 farieb, tak premenné typu Byte je treba predeklarovať na typ Integer prípadne Long:Sub ColorDupsNew()

Dim i As Byte, k As Byte, clrVal As Long, clrValOccupied As Boolean, myRng As Range, cell As Range, j As Byte

Set myRng = Selection

'urcenie nutneho poctu farieb na zaklade poctu duplicit
j = Evaluate("SUM(1/COUNTIF(" & myRng.Address & ",""""&" & myRng.Address & ")) - SUM(--(COUNTIF(" & myRng.Address & ", " & myRng.Address & ")=1))")
ReDim clrArr(1 To j) As Long

'vytvorenie unikatnej kolekcie farieb
For k = 1 To j
clrValOccupied = False
clrVal = RGB(WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255))
For i = 1 To k
If clrArr(i) = clrVal Then
clrValOccupied = True
Exit For
End If
Next i
If clrValOccupied = False Then
clrArr(k) = clrVal
Else: k = k - 1
End If
Next k

myRng.Interior.Pattern = xlNone 'vymaze farby
k = 0
For Each cell In myRng.Cells
If WorksheetFunction.CountIf(myRng, cell) > 1 Then ' existuju duplicity
If WorksheetFunction.Match(cell, myRng, 0) = cell.Row - myRng.Cells(1, 1).Row + 1 Then 'prvy vyskyt duplicity
k = k + 1
cell.Interior.Color = clrArr(k)
Else: cell.Interior.Color = myRng.Cells(WorksheetFunction.Match(cell, myRng, 0), 1).Interior.Color
End If
End If
Next cell
End Sub

@marjankaj: chválim

Tak som si pohral ešte s tým vytvorením unikátnych farieb, takto by to už malo byť o.k.:Sub ColorDupsModified()
Const j = 50 'pocet farieb - predpokladam max 50 roznych farebnych oddtienov
Dim clrArr(1 To j) as Long, i As Byte, k As Byte, clrVal As Long, clrValOccupied As Boolean, myRng As Range, cell As Range

'vytvorenie unikatnej kolekcie farieb
For k = 1 To j
clrValOccupied = False
clrVal = RGB(WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255))
For i = 1 To k
If clrArr(i) = clrVal Then
clrValOccupied = True
Exit For
End If
Next i
If clrValOccupied = False Then
clrArr(k) = clrVal
Else: k = k - 1
End If
Next k

Set myRng = Selection
myRng.Interior.Pattern = xlNone 'vymaze farby
k = 0
For Each cell In myRng.Cells
If WorksheetFunction.CountIf(myRng, cell) > 1 Then ' existuju duplicity
If WorksheetFunction.Match(cell, myRng, 0) = cell.Row - myRng.Cells(1, 1).Row + 1 Then 'prvy vyskyt duplicity
k = k + 1
cell.Interior.Color = clrArr(k)
Else: cell.Interior.Color = myRng.Cells(WorksheetFunction.Match(cell, myRng, 0), 1).Interior.Color
End If
End If
Next cell
End Sub

Na marjankajovo riešenie som sa nepozeral. Cez VBA nejako takto. Vyber si myškou oblasť, v ktorej chceš vyznačiť duplicity (predpokladám, že sa jedná o jeden stĺpec) a spusti kód. Pokiaľ farbičky nevyhovujú, tak spusti kód znovu.Sub ColorDups()
Dim myRng As Range, cell As Range
Set myRng = Selection
myRng.Interior.Pattern = xlNone 'vymaze farby
For Each cell In myRng.Cells
If WorksheetFunction.CountIf(myRng, cell) > 1 Then ' existuju duplicity
If WorksheetFunction.Match(cell, myRng, 0) = cell.Row - myRng.Cells(1, 1).Row + 1 Then 'prvy vyskyt duplicity
cell.Interior.Color = RGB(WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255), WorksheetFunction.RandBetween(0, 255))
Else: cell.Interior.Color = myRng.Cells(WorksheetFunction.Match(cell, myRng, 0), 1).Interior.Color
End If
End If
Next cell
End SubNejedná sa síce o podmienené formátovanie ale účel by to plniť mohlo. Je tam malá pravdepodobnosť, že sa farby budú opakovať, ale taká situácia nastať môže. Dá sa to ošetriť, ale už sa mi nechce, úlohu som bral ako malú rozcvičku.

vovka, chytré, chválim

Použi metódu ListRows.Add

Zadaj do vyhľadávača MS Query. Ja bohužiaľ v tomto viac nepomôžem, nie je to vec, ktorá sa dá vysvetliť či vyriešiť behom piatich minút, a viac času nemám :(

neboť z nějakého neznámého důvodu to náš firmení excel neobsahuje
Dôvodom bude zrejme verzia Office. DatePicker, mám dojem, bol obsiahnutý v knižnici Accessu do verzie 2007, takže pokiaľ máte vo firme novšie Office, tak tam to nie je.

ActiveSheet.ListObjects("TabulkaV").Resize Range("B3:P" & i)

S tým i si asi budeš musieť ešte trochu pohrať, ale základ je, myslím, jasný.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse