MS Excel

Dobrý den,
můžete prosím někdo poradit? Potřeboval bych makro, které bude pracovat následovně. Do třetího sloupce budu psát časové údaje: 10:30-12:15, 12:15-12:45, 12:45 - 14:45. Makro by mělo vždy po stisknutí enteru vzít druhý časový údaj a překopírovat ho na další řádek i s pomlčkou, za kterou by byl kurzor a já mohl doplnit další údaj. Vypadalo by to asi takto: napíší 10:30-12:15 (do první buňky ve třetím sloupci) zmáčknu enter a v druhé buňce třetí sloupce se objeví 12:15- . A tak stále dokola. Doufám, že jsem problém popsal alespoň trochu srozumitelně. Vůbec nevím jak bych takové makro psal. Vždy jsem kopíroval celé buňky. Děkuji za případnou radu.

Uzamčeno - nelze přidávat nové příspěvky.

AL(21.2.2012 20:13)#007374

V kóde listu si musíš napísať príslušnú procedúru pre event Worksheet_SelectionChange, nejak takto:Option Explicit
Dim Isect As Range
Dim Nad As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Isect = Application.Intersect(Range("C2:C500"), Range(ActiveCell.Address))
If Not Isect Is Nothing Then
Set Nad = Isect.Offset(-1, 0)
If Nad <> "" And Isect = "" Then
Isect = "'" & Right(Nad, Len(Nad) - InStr(Nad, "-") - 1) & " - "
End If
End If
End SubHore uvedené bude fungovať pre bunky C2:C500, vykonaj nasledovné kroky:
1. Kód si skopíruj do okna kódu listu, v ktorom to budeš chcieť používať
2. do C1 si zapíš 10:30 - 12:15
3. presuň sa do C2 (klikni, prejdi šípkou apod.)

Má to jednu muchu - tá bunka nezostane editovaná, t.j. budeš si ju buď musieť editovať klávesou F2, alebo dopisovať ten čas DO za pomlčkou do riadku vzorcov. To neviem odstrániť a zrejme to ani nejde, ale inak by to malo fungovať zhruba podľa predstáv, myslím.

Pokiaľ si Stĺpec C sformátuješ na text, tak inštrukciu v tej poslednej podmienke môžeš napísať bez úvodného apostrofu, t.j.:
Isect = Right(Nad, Len(Nad) - InStr(Nad, "-") - 1) & " - "citovat

marjankaj(21.2.2012 22:29)#007377

A čo tak vložiť tam INPUTBOX? Nie je to veľmi praktické, ale na tento účel snáď použiteľné.

Option Explicit
Dim Isect As Range
Dim Nad As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Isect = Application.Intersect(Range("C2:C500"), Range(ActiveCell.Address))
If Not Isect Is Nothing Then
Set Nad = Isect.Offset(-1, 0)
If Nad <> "" And Isect = "" Then
Isect = "' " & WorksheetFunction.Text(Right(Nad, Len(Nad) - InStr(Nad, "-") - 1), "h:mm") & " - "
Isect = Isect & InputBox(Isect)

End If
End If
End Subcitovat

AL(21.2.2012 22:38)#007378

jop, ten InputBox vyrieši problém s mačkaním F2, to je dobrý point. Zase ale pre zmenu nedojde k posunu dolu po odentrovaní(takže je to prašť jak uhoď, resp F2 a Enter vs. Double Enter :)).
Btw, vyhodil som to formátovanie na text, to tam bolo navyše.citovat

marjankaj(21.2.2012 23:08)#007379

Tak som niečo poskúšal. Na konci stačí prázdny ENTER

Option Explicit
Dim Isect As Range
Dim x As String
Dim Nad As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Isect = Application.Intersect(Range("C2:C500"), Range(ActiveCell.Address))
If Not Isect Is Nothing Then
Set Nad = Isect.Offset(-1, 0)
If Nad <> "" And Isect = "" Then
Isect = "'" & Right(Nad, Len(Nad) - InStr(Nad, "-") - 1) & " - "
x = InputBox(Isect)
Isect = Isect & x
If x = "" Then
ActiveCell.Offset(0, 0).Clear
Else
ActiveCell.Offset(1, 0).Select
End If
End If
End If
End Subcitovat

AL(21.2.2012 23:13)#007380

Že na konci stačí prázdny Enter som pochopil, ale chápem, že je to adresované J.A.Kovi, ktorý by mal oceniť snahu. Z môjho pohľadu je Tvoj pokus už hooodne profesionálny.citovat

marjankaj(21.2.2012 23:25)#007381

No vlastne si to vymyslel ty. Mne iba vŕtalo, prečo by to nešlo vylepšiť. :)citovat

J.A.K(22.2.2012 10:51)#007382

Je to perfektní. Moc děkuju. Ani jsem nečekal, že se tu objeví takových nápadů. Ještě jednou díky moc!

citovat

J.A.K(22.2.2012 10:56)#007383

Ještě jedna věc. Šlo by prosím nějak odstranit mezery? Aby se nemuselo psát 12:10 - 12:45, ale 12:10-12:45. Když tam tu mezeru neudělám, tak mi to tu jedničku nevezme a zůstane jen: 2:10-citovat

AL(22.2.2012 11:01)#007384

Odstráň - 1 a medzery pred a za pomlčkou v:
Isect = "'" & Right(Nad, Len(Nad) - InStr(Nad, "-") - 1) & " - "

Takže napíš
Isect = "'" & Right(Nad, Len(Nad) - InStr(Nad, "-")) & "-"citovat

J.A.K(22.2.2012 11:34)#007386

Je to perfektní. Budu používat možnost bez INPUTBOXu, ale dík za vše!citovat

Téma: Překopírování části hodnoty

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje