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

Příspěvky uživatele

http://wall.cz/index.php?m=topic&id=22744&page=1#post-22756
Viz odkaz v mém příspěvku
napodruhé jsem se soustředil a funguje to

Včera jsem zkoušel toto
http://excelmatters.com/2014/12/10/office-update-breaks-activex-controls/

Dnes jsem zkusil oddinstalovat uvedenou aktualizaci
zatím nic nepomohlo ;)

MístoWrite #2, CellDatavložtePrint #2, CellData

Asi takhle
Vytváření sešitů a VBA projektů považuji za programování jako každé jiné (i když si to jiní programátoři často nemyslí). Tzn., že pokud někdo uzamkne sešit nebo list má k tomu důvod a Vy a všichni ostatní byste to měli respektovat. Zveřejněním tohoto kódu v podstatě napomáháte některým lidem ke krádežím duševního vlastnictví jiných autorů - můžete si myslet, že zveličuji, můžete se tomu smát, ale myslím to vážně. A to, že jste jej našel někde na internetu to nijak nesnižuje, naopak - opět jste zveřejnil něco co není Vaše bez odkazu odkud to máte a asi i bez souhlasu autora (i když tenhle se na Vás asi zlobit nebude). Napadá mně jednoduché řešení, které by mohlo fungovat, ale zkoušet ho nebudu a ani Vám ho nesdělím. Pouze požádám Vás nebo admina o stažení toho kódu.

Občas mi ale někdo nějaký list při editacích zamkne jiným heslem
Na to je jednoduché řešení - zamkněte a heslo nikomu nesdělujte - pokud má mít někdo právo udělat v sešitu změny tak mu ho sdělte nebo mu řekněte, že ty změny má provést ve spolupráci s Vámi. Pokud se Vám to přeci jen stane, pravděpodobně sklízíte vlastní ovoce.

Možná se k tomu MS konečně postavil čelem - i když to už asi situaci se zabezpečením nijak nezachrání.

NapříkladRange("C1").Value = Application.WorksheetFunction.Trim(Join(Evaluate("TRANSPOSE(IF(A2:A22=""BEROUN"",B2:B22,""""))"), " "))

Tak a omlouvám se za spam - ale ještě jsem provedl integraci procedury subStart do Vašeho userformuPrivate Sub CommandButton1_Click()
Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), CLng(jednotkyTB.Text))

Dim sCombinations() As String
ReDim sCombinations(1 To 1) As String

Dim i As Long
For i = 1 To UBound(sResult)
If Len(sResult(i)) - Len(Replace(sResult(i), ";", vbNullString)) = (CByte(lidiTB.Text) - 1) Then
If Not sCombinations(1) = vbNullString Then
ReDim Preserve sCombinations(1 To UBound(sCombinations) + 1)
End If
sCombinations(UBound(sCombinations)) = sResult(i)
End If
Next i

Range("A25").CurrentRegion.ClearContents
Range("A25").Resize(UBound(sCombinations), 1).Value = Application.Transpose(sCombinations)

Unload Me
End Sub

poznámka - v tomto případě musí buď být procedury subFindCombinations a subAddItem v modulu userformu nebo procedura subFindCombinations nesmí být Private.

Pokud upravím kód například takto:Sub subStart()
Const ITEMS_COUNT As Byte = 4
Const SUM As Integer = 200

Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), SUM)

Dim sCombinations() As String
ReDim sCombinations(1 To 1) As String

Dim i As Long
For i = 1 To UBound(sResult)
If Len(sResult(i)) - Len(Replace(sResult(i), ";", vbNullString)) = (ITEMS_COUNT - 1) Then
If Not sCombinations(1) = vbNullString Then
ReDim Preserve sCombinations(1 To UBound(sCombinations) + 1)
End If
sCombinations(UBound(sCombinations)) = sResult(i)
End If
Next i

Range("A25").CurrentRegion.ClearContents
Range("A25").Resize(UBound(sCombinations), 1).Value = Application.Transpose(sCombinations)
End Subvypíše mi všechny kombinace pro součet 200 a počet 4. Není tam řešena jedinečnost. Zaprvé si z Vašeho zadání pořád nejsem 100% jistý, co chcete a za druhé už nemám moc času. Takže buď si musíte dodělat sám nebo Vám tady někdo pomůže.

Poznámka - pokud nepotřebujete všechny kombinace, můžete omezení prvků samozřejmě řešit už v rámci procedury subFindCombinations - což trošku zkrátí běh kódu...

100 + 2 => součet = 100, počet = 2
ve skupině pouze jedenkrát, to je jasné, ale může být ve více skupinách?

Protože se málokdy vyskytne zadání, ne kterém se dá potrénovat volání procedury "sama sebe", tak jsem potrénoval.
Vyhledá to všechny možné kombinace a z nich už si potom sám můžete vyselektovat, které chcete.

Option Explicit

Sub subStart()
Dim sResult() As String
ReDim sResult(1 To 1)

Call subFindCombinations(sResult, Range("C1:C15"), 100)

'v tuto chvíli máte v proměnné (poli) sResult všechny možné kombinace vyhovující bez ohledu na jejich počet
'můžete tedy projet toto pole, vybrat si ty kombinace, které chcete a dále s nimi pracovat (například pokud tam je 1 středník - máte dva prvky)
End Sub

Private Sub subFindCombinations(ByRef sResult() As String, ByVal rRange As Range, ByVal iSum As Long, Optional sPreItems As String = vbNullString, Optional iFromRow As Long = 0)
Dim vVals As Variant
If rRange.Rows.Count = 1 Then
ReDim vVals(1 To 1)
vVals(1) = rRange.Value
Else
vVals = Application.Transpose(rRange.Value)
End If

Dim i As Long
For i = 1 To rRange.Rows.Count
If vVals(i) = iSum Then
Call subAddItem(sResult, sPreItems & ";" & iFromRow + i)
ElseIf vVals(i) < iSum Then
If i < rRange.Rows.Count Then
Call subFindCombinations(sResult, Range(rRange.Cells(i + 1), rRange.Cells(rRange.Rows.Count)), iSum - rRange.Cells(i).Value, sPreItems & ";" & iFromRow + i, iFromRow + i)
End If
End If
Next i

Set rRange = Nothing
End Sub

Private Sub subAddItem(ByRef sResult() As String, ByVal sValue As String)
If Not sResult(1) = vbNullString Then
ReDim Preserve sResult(1 To UBound(sResult) + 1)
End If

If sValue Like ";*" Then
sValue = Mid(sValue, 2)
End If
sResult(UBound(sResult)) = sValue
End Sub

Jen technická
Pokud je výběr 100 + 2 a
pokud je Adolf AAA (60) + Matěj BBB (40)
Adolfa vyřazujete nebo může být další skupina Adolf AAA (60) + Milan DDD (40)

Dal jste obrázek, tak dám taky obrázek (té logice vkládat obrázky místo příloh totiž nerozumím)
Použil jsem vzorce
=ČAS(0;USEKNOUT(B2/100);MOD(B2;100))-ČAS(0;USEKNOUT(A2/100);MOD(A2;100))=ČAS(0;USEKNOUT(B2/100);MOD(B2;100))+ČAS(0;USEKNOUT(A2/100);MOD(A2;100))

V tom případě bych na Vašem místě daný list uložil jako csv oddělené středníkem. Pak otevřel v poznámkovém bloku a dal nahradit tečku za čárku, otevřel v excelu a hodnoty překopíroval do původního souboru.

Šlo by to udělat i pomocí vzorců, ale nevíte kde excel použil d.m, kde m.y a kdo ví co ještě, takže takhle mi to přijde jednodušší.

Jak je mým zvykem v poslední době, jen si tipnu.
Ta data jsou importovaná? Pokud ano, tak z jakého zdroje? Nastavte při importu oddělovač desetinných míst na . a máte vyhráno.

Také neznám Mac - ale Google Vám tam určitě funguje
Takže - máte klávesu OPTION?

https://support.office.com/en-ca/article/Move-or-copy-a-sheet-0e5acaa3-5968-4d7d-b5ce-eb67b2d93521?ui=en-US&rs=en-CA&ad=CA

Vyzkoušejte a dejte vědět, jestli kopírování listu postačí. Můžete kopírovat i více listů najednou tak, že si je všechny označíte a na tom aktivním provedete kopírování (ve win ctrl+myš) = nemusíte dělat 99x.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje