< návrat zpět

MS Excel

Téma: Makro maximum minimum rss

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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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: zip33718_makro.zip (65kB, staženo 28x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje