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

MS Excel

Téma: Makro maximum minimum

Zaslal/a MartinQQ 2.12.2016 8:27

Zdravím, jsem začátečník a potřeboval bych malou radu. Snažím se vytvořit macro, které vyhledá maximální a minimální datum ze dvou sloupců ( nejlépe ze sloupců zadaných pomocí textboxu) po najití vypíše časovou osu včetně minima a maxima na první řádek do buňky která bude jako první volná. Najití minimální maximální hodnoty a vypsání časové osy mi už jde. Takže se jedná o zadání hodnot sloupců pomocí textboxu a vypsání na první řádek. Snad je to aspoň trochu srozumitelné. Děkuji

_________
Sub makro1()
Dim dtMin As Date
Dim dtMax As Date
Dim lngLastRow As Long
Dim StartD As Date, EndD As Date
lngLastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
lngLastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row

dtMin = WorksheetFunction.Min(Range("E1:E" & lngLastRow))
dtMax = WorksheetFunction.Max(Range("F1:F" & lngLastRow))

MsgBox dtMin
MsgBox dtMax
StartD = dtMin
EndD = dtMax + 1

For Row = 1 To EndD - StartD
Cells(Row, 3) = StartD + Row - 1
Next Row

End Sub

Zaslat odpověď >

---

TEDO(4.12.2016 16:33)#033650

Zkus
Sub makro1()
Dim dtMin As Date
Dim dtMax As Date
Dim Sloupec1 As String
Dim Sloupec2 As String
Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim StartD As Date, EndD As Date

Sloupec1 = InputBox("Zadej první sloupec")
Sloupec2 = InputBox("Zadej druhý sloupec")
lngLastRow1 = ActiveSheet.Cells(Rows.Count, Sloupec1).End(xlUp).Row
lngLastRow2 = ActiveSheet.Cells(Rows.Count, Sloupec2).End(xlUp).Row

dtMin = WorksheetFunction.Min(Range(Cells(1, Sloupec1), Cells(lngLastRow1, Sloupec1)))
dtMax = WorksheetFunction.Max(Range(Cells(1, Sloupec2), Cells(lngLastRow2, Sloupec2)))
MsgBox dtMin
MsgBox dtMax
StartD = dtMin
EndD = dtMax + 1

For i = 1 To EndD - StartD
Cells(i, 3) = StartD + i - 1
Next i
End Subcitovat

MartinQQ(5.12.2016 8:18)#033675

Děkuji zadání sloupců funguje, teď se mi ale jedná o zápis osy. Kód mám zapsaný takto, že osu začne vypisovat od G1 a dál H1,I1. Ale jedná se mi o to, že nebudu zapisovat vždy od G1 ale třeba až od L1 prostě první buňka která bude volná. Nemáte nějaký nápad, jak to udělat aby nebyla hodnota zadaná na pevno? Děkuji.


For i = 1 To EndD - StartD

Cells(1, i + 6) = StartD + i - 1

Next icitovat

TEDO(5.12.2016 18:31)#033690

může být toto?
[codeSub makro1()
Dim dtMin As Date
Dim dtMax As Date
Dim Sloupec1 As String
Dim Sloupec2 As String
Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim lngLastColumn As Long
Dim StartD As Date, EndD As Date

Sloupec1 = InputBox("Zadej první sloupec")
Sloupec2 = InputBox("Zadej druhý sloupec")
lngLastRow1 = ActiveSheet.Cells(Rows.Count, Sloupec1).End(xlUp).Row
lngLastRow2 = ActiveSheet.Cells(Rows.Count, Sloupec2).End(xlUp).Row
If Len(ActiveSheet.Cells(1, 7)) = 0 Then
lngLastColumn = 7
Else
lngLastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
End If

dtMin = WorksheetFunction.Min(Range(Cells(1, Sloupec1), Cells(lngLastRow1, Sloupec1)))
dtMax = WorksheetFunction.Max(Range(Cells(1, Sloupec2), Cells(lngLastRow2, Sloupec2)))

MsgBox dtMin
MsgBox dtMax

StartD = dtMin
EndD = dtMax + 1

For i = 1 To EndD - StartD
Cells(i, lngLastColumn) = StartD + i - 1
Next i

End Sub
][/code]citovat

MartinQQ(6.12.2016 10:05)#033694

No, ano na tenhle princip jsem to přesně chtěl, jen jde o to, že potřebuji vyplnit první řádek ale ne sloupec protože k tomu už mám připravené další makro, kde časovou osu mám v řádku a pod vyplnuji další data to by mělo jít ne?citovat

TEDO(6.12.2016 20:15)#033705

Sub makro1()
Dim dtMin As Date
Dim dtMax As Date
Dim Sloupec1 As String
Dim Sloupec2 As String
Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim lngLastRow3 As Long
Dim StartD As Date, EndD As Date

Sloupec1 = InputBox("Zadej první sloupec")
Sloupec2 = InputBox("Zadej druhý sloupec")
lngLastRow1 = ActiveSheet.Cells(Rows.Count, Sloupec1).End(xlUp).Row
lngLastRow2 = ActiveSheet.Cells(Rows.Count, Sloupec2).End(xlUp).Row
If Len(ActiveSheet.Cells(1, 7)) = 0 Then
lngLastRow3 = 1
Else
lngLastRow3 = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row + 1
End If

dtMin = WorksheetFunction.Min(Range(Cells(1, Sloupec1), Cells(lngLastRow1, Sloupec1)))
dtMax = WorksheetFunction.Max(Range(Cells(1, Sloupec2), Cells(lngLastRow2, Sloupec2)))

MsgBox dtMin
MsgBox dtMax

StartD = dtMin
EndD = dtMax + 1

For i = 1 To EndD - StartD
Cells(lngLastRow3, i + 6) = StartD + i - 1
Next i

End Sub
citovat

MartinQQ(8.12.2016 7:46)#033718

Omlouvám se, že otravuji přiložil jsem jednoduchý příklad excelu pro praxi. Vlastně se mě jedná o to, že časová osa bude vždy na prvním řádku, ale nevím v které buňce bude začínat, jestli H1,I1,J1 apod. Prostě abych neměl zadanou na pevno hodnotu +6,+7. Makro se bude používat ve více souborech a pokaždé nebude stejný. Snad už si teď rozumíme, zkoušel jsem to nějak udělat tak, že budu projíždět první řádek dokud nenarazím na prázdnou buňku tak poté až začnu zapisovat časovou osu, ale bez úspěchu.

Příloha: 33718_makro.zip (65kB, staženo 28x)

citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse