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

Příspěvky uživatele

No to mate sice pravdu, ze LARGE nevraci poradi (proc by taky mela, kdyz od toho je RANK), ale kdybyste si do bunek vypsal poradi a k nim pouzil funkci LARGE, tak byste videl, ktera hodnota je nejvetsi, ktera je druha nejvetsi...atd (zaroven byste videl, ze nejvetsi je napr. 4 a druha nejvetsi je taky 4 (kdyz by byly tyto hodnoty duplicitni a zaroven maximem mnoziny)

zjistit, jestli hodnota je nebo neni obsazena v oblasti, lze kazdou vyhledavaci funkci, napr. POZVYHLEDAT.
=KDYŽ(JE.CHYBHODN(POZVYHLEDAT(hodnota;oblast;0));0;1) -> pokud hodnota v oblasti je, vrati 1; pokud neni, vrati 0 (standardni hodnoty pro True a False)

Zkuste se podívat na funkci LARGE, mohla by pomoci...

...myslim, ze ten vzor bude vice nez nutny...

Pokud vim, tak zadne takove specialni nastaveni neni.
Pocet se vzdy nastavuje v pripade, ze:
1) v oblasti dat nejsou jen hodnoty (cisla)
2) v oblasti dat jsou prazdne bunky

Pokud tedy potrebujete Soucet hodnot, PRED VYTVORENIM KONT. TABULKY:
1) vyberte zdroj dat presne (bez prazdnych) bunek) a
2) ujistete se, ze Data obsahuji pouze cisla.

Zkus tohle (sice jsem to psal jen tak po paměti, ale mohlo by to fungovat):
Dim ChB As Control
For Each ChB In UserForm.Controls
If TypeName(ChB) = "CheckBox" And ChB.Value = True Then
MsgBox ChB.Name & " je zaškrtnutý"
End If
Next ChB

Musim se priznat, ze jsem to nezkoumal uplne do hloubky a castecne souhlasim s Pavlusem - misty je to velmi podivne napsane, nicmene zase takova katastrofa to neni :-)
Rekl bych, ze by chyba mohla byt zpusobena tim, ze se v ramci procedury volane tlacitkem spusti procedura navazana na zmenu bunky K1.

Proto bych na zacatek procedury tlacitka dal:
Application.EnableEvents = False tento zapis zajisti to, ze bude znemozneno volani procedur spoustenych na zaklade udalosti.
Na konci kodu je pak nutne udalosti znovu 'zapnout'
Application.EnableEvents = True

Tady je ten Update textboxu pri zmene textboxu5.

Ohledne toho 'pamatovani si' - to asi nepujde, protoze vzdy kdyz chces, aby se neco stalo, musi se spustit procedura - takze jedine reseni je, aby ulozeni dat netrvalo tak dlouho, jak pises (coz se mi zda divne).
Ale stejne si myslim, ze neni stastne, aby se jakakoliv data ukladala bez vedomi uzivatele (tedy bez toho, aby vyslovene stiskl tlacitko ULOZIT)

Protoze to ma byt dostupne pro vsechny otevrene .csv soubory - vlozte nasledujici tri kody do sesitu Personal.xlsb (office 2007 nebo 2010) a spoustejte kod: Uprava_CSV (dalsi dva kody jsou volane z tlacitek).
- Vyrobce neni ukladan jako vzorec, ale jako text, protoze po ulozeni csv se stejne vsechny vzorce ztrati a zustane jen hodnota.
- klavesovou zkratku pro proceduru Uprava_CSV lze nastavit az u vas v PC

Sub CSV_uprava()
Dim i As Long
Dim Zprava_sesity As String, Vys_sesity
Dim wbSesit As Workbook, Radek As Long

'-------------------------Nastavení sešitu
For i = 1 To Workbooks.Count
If Right(Workbooks(i).Name, 3) = "csv" Then
Zprava_sesity = Zprava_sesity & i & ": " & Workbooks(i).Name & vbNewLine
End If
Next i

Vys_sesity = InputBox("Zapiš číslo CSV souboru, pro který chceš provést změny." & vbNewLine & _
"(pokud soubor není v seznamu, zřejmě není otevřen nebo je otevřen v jiné instanci Excelu)" _
& vbNewLine & "-------------------------------------------------------" & vbNewLine & _
Zprava_sesity, "Vyber CSV soubor...")

If IsNumeric(Vys_sesity) = False Then
MsgBox "Musíte zadat číslo!" & vbNewLine & "Tato procedura bude nyní ukončena...", vbCritical
Exit Sub
End If

If Right(Workbooks(CLng(Vys_sesity)).Name, 3) <> "csv" Then
MsgBox "Toto není platné číslo souboru CSV ze seznamu!" & vbNewLine & "Tato procedura bude nyní ukončena...", vbCritical
Exit Sub
End If

Set wbSesit = Workbooks(CLng(Vys_sesity))
'------------------------------------------------

'-----------------------------------začátek úprav
wbSesit.Activate
Radek = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").RowHeight = 45
Range("a1:K1").Interior.Color = vbGreen
Columns("A:K").AutoFilter

Range("A2").Select
ActiveWindow.FreezePanes = True

ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
"D2:D" & Radek), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:K" & Radek)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'tlačítka
ActiveSheet.Buttons.Add(148.5, 4.5, 71.25, 22.5).Select
Selection.OnAction = "PERSONAL.XLSB!Vyrobce1"
Selection.Characters.Text = "Výrobce 1"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Calibri"
.FontStyle = "Obyčejné"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

ActiveSheet.Buttons.Add(230.25, 5.25, 78.75, 22.5).Select
Selection.OnAction = "PERSONAL.XLSB!Vyrobce2"
Selection.Characters.Text = "Výrobce 2"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Calibri"
.FontStyle = "Obyčejné"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

ActiveSheet.Buttons.Add(480.75, 3.75, 46.5, 22.5).Select
Selection.OnAction = "PERSONAL.XLSB!UlozCSV"
Selection.Characters.Text = "ulož CSV"
With Selection.Characters(Start:=1, Length:=8).Font
.Name = "Calibri"
.FontStyle = "Obyčejné"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("a1").Select

End Sub

Sub Vyrobce1()
Dim Sloupec As Long, Vyrobce1 As String
Dim Bunka

Sloupec = 3

If Selection.Columns.Count > 1 Then
MsgBox "Výběr nesmí mít více než 1 sloupec" & vbNewLine & vbNewLine & "...procedura bude ukončena...", vbCritical
Exit Sub
End If

If Selection.Column <> 3 Then
MsgBox "Výběr musí být proveden ve sloupci C (č. 3)" & vbNewLine & vbNewLine & "...procedura bude ukončena...", vbCritical
Exit Sub
End If

For Each Bunka In Selection
Vyrobce1 = Left(Cells(Bunka.Row, 4), InStr(1, Cells(Bunka.Row, 4), " ") - 1)
Bunka.Value = Vyrobce1
Next Bunka

End Sub

Sub Vyrobce2()
Dim Sloupec As Long, Vyrobce2 As String
Dim Bunka

Sloupec = 3

If Selection.Columns.Count > 1 Then
MsgBox "Výběr nesmí mít více než 1 sloupec" & vbNewLine & vbNewLine & "...procedura bude ukončena...", vbCritical
Exit Sub
End If

If Selection.Column <> 3 Then
MsgBox "Výběr musí být proveden ve sloupci C (č. 3)" & vbNewLine & vbNewLine & "...procedura bude ukončena...", vbCritical
Exit Sub
End If

For Each Bunka In Selection
Vyrobce2 = Left(Cells(Bunka.Row, 4), InStr(InStr(1, Cells(Bunka.Row, 4), " ") + 1, Cells(Bunka.Row, 4), " ") - 1)
Bunka.Value = Vyrobce2
Next Bunka

End Sub

Sub UlozCSV()
ActiveWindow.FreezePanes = False
Rows(1).Delete
ActiveWorkbook.SaveAs , FileFormat:=xlCSV
ActiveWorkbook.Close True
End Sub

Jde udelat temer vsechno, ale musi se vedet, co presne chceme.
Jestli to chapu spravne, tak cilem je, aby se po zapsani cisla do TextBoxu5 zmenil obsah ostatnich textboxu, aby odpovidal zadanemu cislu v boxu 5 - je to tak?

Metoda .find hleda tak, jak ji zadate, takze jestli hleda jen cast (pak je mozne, ze najde i 104090 misto pouze 1040), takze potrebujete rict, ze se ma hledat jen cela hodnota, nejen cast)

Prozkoumejte metodu .find a zjistite, ze ma i vlastnost 'lookat'.

pridal bych do metody .find 'Lookat:=xlwhole'

...ale pouze odhaduju, neznam vasi proceduru podrobne, jen jsem to tak prolitl...

Nejdriv je potrebova (v inicializaci formulare nastavit min a max hodnotu posuvniku a pak uz je to jednoduche...

Ja myslim, ze je to zrejme - hned prvni cast kodu rika, ze se makro provede jen v pripade, ze ke zmene bunky dojde na bunce F13 (v jine bunce fungovat nebude)

takze staci upravit tuto cast (a pridat bunky, napr. A1 a B1)
' Testování změn v buňkách
If .Address = "$F$13" Or .Address = "$A$1" Or .Address = "$B$1" Then
Else
Exit Sub
End If

Jen doplnim.
Nelze v modulu listu napsat
Sheets(2).Activate
Range("a1").Selectprotoze implicitne je jako defaultni list brany ten list, v jehoz modulu se kod nachazi.

Lze to ale obejit takto:
Sheets(2).Activate
Sheets(2).Range("a1").Select

Takhle bez znalosti toho, co se v tom makru deje, to lze jen velmi tezko rict, ale pokud mate vypnuty prepocitavani i prekreslovani obrazovky
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = Falses jejich pozdejsim nastavenim na puvodni hodnoty, tak se lze spise jen podivat na to, jestli skutecne potrebujete 6 vnorenych cyklu - myslim tim, jestli to nejde provest nejakym jinym zpusobem hledani nebo vypoctu...

Zkus se podivat se podivat ve VBE do: Tools/References,
jestli tam neni nekde u nejake knihovny uvedeno MISSING - takove knihovny odskrtni - mohlo by pomoci

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse