Text do sloupců a makro - VYŘEŠENO

peterson864 · 24. 3. 2015 00:05:55

Ahoj, potřeboval bych poradit, mám sloupec datumů s hodinami, ale je to obyčejný text a já ho chci převést na datum s časem. Přes funkci Text do sloupců to funguje dobře, ale problém je, že to chci nahrát do makra. Spustím "Zaznamenat makro", použiju Text do sloupců a uložím makro.
Ale když to makro spustím, tak to nic neudělá. Nevíte někdo co s tím? Díky za odpověď

Tady je zkušební soubor: http://uloz.to/xbmdoaxC/hodiny-test-ods

Editoval peterson864 (25. 3. 2015 14:51:38)

neutr · 24. 3. 2015 08:20:59

Ten soubor neobsahuje makro. To Vám zůstalo ve vešich makrech Standard. Měl byste ho uložit do sešitu "Hodiny - test". Stejně nějak nechápu oč vám jde. Tento výstup je po použití funkce NOW?
1. Udělejte si v buňce C2 vzorec =VALUE(A2)
2. V buňce D2 =INT(C2)
3. V Buňce E2 =D2 - ale udělejte z té buňky formát - datum (Formát Buňky - čísla - datum)
4. V buňce F2 =C2-D2
5. V buŇce G2 =F2 - ale udělejte z té buňky formát - čas (Formát Buňky - čísla - čas)
----------------------To je pro pochopení principu-----------------------
Naostro do buňky C3 vzorec : =INT(VALUE(A3)) - formát buňky DATUM
Naostro do buňky D3 vzorec : =VALUE(A10)-C10 - formát buňky ČAS
--------------------- Nahrání makra--------------------------------------
1. Postavit se do buňky B2 a spustit nahrávání.
2. Udělat šipkou krok v pravo (do vzorce) - kliknout na příkazový řádek a stisknout INSERT (následně ENTER - to se ale v makru musí dodatečně smazat).
3. V okně "pole názvu" zadejte D2:D2 a ENTER.
4. Opět klikněte do editačního řádku a stiskněte ENTER.
5. V okně "pole názvu" zadejte C2:C2 a ENTER. Následně Zavolejte formát buňky - Datum
7. V okně "pole názvu" zadejte D2:D2 a ENTER. Následně Zavolejte formát buňky - ČAS.
8. V okně "pole názvu" zadejte C2:D2 a ENTER. Nyní zadejte kopírovat a ukončete nahrávání.
9. Makro uložte do sešitu "Hodiny-Test".
Následně musíte makro otestovat. Nejspíš napoprvé správně fungovat nebude. Musíte smazat sekvence kódu za nahráváním těch vzorců - jsou to výběry úseků. Pokud se v makru kdekoliv vyskytne list (číslo) - celý příkaz smažte. Smažte také všechny dolary pokud se Vám tam vyskytnou. Pak znovu otestujte makro.
Někdy se stane, že se zvolený úsek nahraje 2x za sebou - to je zbytečné. To ale dělá asi jenom LibreOffice - Vy jste použil AOO.
Konečná úprava kódu by měla vypadat :
- Deklarace a vložení vzorce (Datum)
- krok vpravo
- Deklarace a vložení vzorce (ČAS)
- Formát buňky (ČAS)
- KrokVlevo
- Formát buňky (DATUM)
Potom vzorec začne a skončí ve stejné buňce. Vy zadáte SHIFT + šipka vpravo, následně zkopírujete a vložíte do jakéhokoliv úseku ve stejném sloupci, popřípadě to vystřihnete vložíte jinam, zkopírujete a a vložíte kam je libo.

Chcete - li něco jiného postněte sem ukázku.

Editoval neutr (24. 3. 2015 08:35:40)

ludviktrnka · 24. 3. 2015 15:01:33

Můžete použít toto makro.

Sub prevod_data()

	dokument = ThisComponent
	vyber = dokument.currentselection	
	list = dokument.sheets(vyber.rangeaddress.sheet)

	start_radek = vyber.rangeaddress.startrow
	start_sloupec = vyber.rangeaddress.startcolumn
	konec_radek = vyber.rangeaddress.endrow
	konec_sloupec = vyber.rangeaddress.endcolumn

	for radek = start_radek to konec_radek

		for sloupec = start_sloupec to konec_sloupec

			bunka = list.getcellbyposition(sloupec, radek)
			datum = datevalue(bunka.string)
			cas = timevalue(bunka.string)
			bunka.value = datum + cas
			bunka.NumberFormat = 50
			
		next sloupec

	next radek
	
End Sub

Označíte buňky, spustíte makro. Bohužel neumím moc dobře nastavit formát, třeba ještě někdo zde poradí jak se to dělá správně.

Pokud bude formát jen číslem tak formát 50 je DD.MM.RR HH.MM a 51 je DD.MM.RRRR HH.MM.SS zvolte co libo

Editoval ludviktrnka (24. 3. 2015 15:14:41)

ludviktrnka · 24. 3. 2015 15:40:47

... jsem nějaký nepouřitelný, kdysi mi LP napsal jak se nastavuje formát a já to už dokonce použil a zase zapomněl. Nicméně nějak si mě to zase našlo:

Sub prevod_data_format()

	dim muj_format
	dim format_data as string
	dim dokument, bunka as object
	dim jazyk as new com.sun.star.lang.Locale

	dokument = ThisComponent

	format_data = "D. M. YYYY H:MM:SS" 'zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu
	muj_format = dokument.NumberFormats.queryKey( format_data, jazyk, true )
	if (muj_format = - 1) then
	muj_format = dokument.getNumberFormats().addNew( format_data, jazyk )
	endif

	vyber = dokument.currentselection 'vyber bude znamenat libovolně velký počet buněk, tedy nikoli jen nednu	
	list = dokument.sheets(vyber.rangeaddress.sheet)

	start_radek = vyber.rangeaddress.startrow
	start_sloupec = vyber.rangeaddress.startcolumn
	konec_radek = vyber.rangeaddress.endrow
	konec_sloupec = vyber.rangeaddress.endcolumn

	for radek = start_radek to konec_radek

		for sloupec = start_sloupec to konec_sloupec

			bunka = list.getcellbyposition(sloupec, radek)
			datum = datevalue(bunka.string)
			cas = timevalue(bunka.string)
			bunka.value = datum + cas
			bunka.NumberFormat = muj_format

		next sloupec

	next radek
	
End Sub

peterson864 · 24. 3. 2015 18:46:29

Ahoj, díky za odpovědi.

Neutr: Zkusil jsem to podle tvého návodu, ale u toho makra jsem to někde pokazil. Já jsem se o calc začal zajímat teprve před týdnem, takže spoustu věcí nechápu a dělám blbosti

ludviktrnka: Tvoje makro funguje tak jak chci, jen jsem se chtěl zeptat, šlo by to upravit aby když vyberu celý sloupec, tak to ignorovalo prázdné buňky? Pak mi to hází tuhle chybu: http://uloz.to/xJRSG4Cz/chyba-makro-png

Díky

P.S. Existuje na Calc nějaká pořádná kniha?

Editoval peterson864 (24. 3. 2015 18:47:22)

neutr · 24. 3. 2015 19:14:08

Celkově asi ne. Vše se dost prudce vyvíjí. Jedna věc jsou uživatelské možnosti a druhá věc je programování. To je popsáno poměrně dobře v seriálu Daniela Sedláčka "Malá makra". Já osobně fandím lidem, kteří se pokoušejí do tajů proniknout všemy způsoby.
Pokud chcete prázdné buňky přeskakovat, musíte vložit podmínku například - ale bez zkoušení do makra Ludvíka Trnky vložte :
for sloupec = start_sloupec to konec_sloupec

bunka = list.getcellbyposition(sloupec, radek)
IF bunka.string = "" Then
GoTo Hopsasa
Else
datum = datevalue(bunka.string)
cas = timevalue(bunka.string)
bunka.value = datum + cas
bunka.NumberFormat = muj_format
End If
Hopsasa:
next sloupec
Píšu z hlavy tak to není otestované

Editoval neutr (24. 3. 2015 19:15:20)

ludviktrnka · 24. 3. 2015 20:00:39

jo to lze, nakopíroval jsem neutrovu podmínku a přidal oštření jakékoli chyby ukončením programu ať to nehlásí zbytečně chyby. Program se ukončí tehdy pokud narazí na buňku která nemá textový formát a neobsahuje nějak zapsané datum s časem. Provede veškeré výměny až do problematické buňky a pak se ukončí. Jaká buňka bude problematická nevím, to je potřeba vyzkoušet. Vaše údaje tak jak jste je poslal to všechny chroustá v pořádku :-)

Sub prevod_data_format()

dim muj_format
dim format_data as string
dim dokument, bunka as object
dim jazyk as new com.sun.star.lang.Locale

dokument = ThisComponent

on error goto konec
		
format_data = "D.M.YYYY H:MM:SS" 'zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu
muj_format = dokument.NumberFormats.queryKey( format_data, jazyk, true )
if (muj_format = - 1) then
   muj_format = dokument.getNumberFormats().addNew( format_data, jazyk )
endif

vyber = dokument.currentselection 'vyber bude znamenat libovolně velký počet buněk, tedy nikoli jen jednu	
list = dokument.sheets(vyber.rangeaddress.sheet)

start_radek = vyber.rangeaddress.startrow
start_sloupec = vyber.rangeaddress.startcolumn
konec_radek = vyber.rangeaddress.endrow
konec_sloupec = vyber.rangeaddress.endcolumn

for radek = start_radek to konec_radek

   for sloupec = start_sloupec to konec_sloupec
		
      bunka = list.getcellbyposition(sloupec, radek)
			
      IF bunka.string = "" Then
         GoTo Hopsasa
      Else
         datum = datevalue(bunka.string)
         cas = timevalue(bunka.string)
         bunka.value = datum + cas
         bunka.NumberFormat = muj_format
      End If
			
      Hopsasa:

   next sloupec

next radek
	
konec:
	
End Sub

... textový formát není podmínkou správné funkce, v buňce prostě musí být datum + čas. A pokud je ve výběru problematická buňka, program neudělá nic ... tož to jen oprava výše uvedené informace.

Editoval ludviktrnka (24. 3. 2015 20:12:56)

peterson864 · 24. 3. 2015 20:10:42

Díky moc, funguje to perfektně

ludviktrnka · 27. 3. 2015 09:07:00

... trochu off topic ale ještě mě v noci vrtalo hlavou, jak udělat aby makro vynechávalo buňky, které nelze zfrmovat do požadovaného tvaru a neskončilo chybou ale prostě tyto buňky ignorovalo. Hledal jsem něco co by mělo podobný význam jako má v sešitu funkce ISERROR(), ale nenašel jsem. Proto jsem zkusil takový divný příkaz RESUME NEXT, který nuluje chybu a vrací běh na následující řádek. Moc se mi nelíbí když program skáče jak koza, ale fakt je že to funguje.

Sub prevod_data_format()

  dim muj_format
  dim format_data as string
  dim dokument, bunka as object
  dim jazyk as new com.sun.star.lang.Locale

  dokument = ThisComponent
  pocet_chyb = 0

  'zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu		
  format_data = "D.M.YYYY H:MM:SS" 
  muj_format = dokument.NumberFormats.queryKey( format_data, jazyk, true )
  if (muj_format = - 1) then
    muj_format = dokument.getNumberFormats().addNew( format_data, jazyk )
  endif

  'vyber bude znamenat libovolně velký počet buněk, tedy nikoli jen jednu
  vyber = dokument.currentselection
  list = dokument.sheets(vyber.rangeaddress.sheet)

  start_radek = vyber.rangeaddress.startrow
  start_sloupec = vyber.rangeaddress.startcolumn
  konec_radek = vyber.rangeaddress.endrow
  konec_sloupec = vyber.rangeaddress.endcolumn

  for radek = start_radek to konec_radek
    for sloupec = start_sloupec to konec_sloupec
      bunka = list.getcellbyposition(sloupec, radek)
			
      IF bunka.string = "" Then
        GoTo Hopsasa
      Else
        on error goto chyba
        'tady nastavím chybičku na nulu, v případě chyby se změní na jedničku				
        chybicka = 0
        datum = datevalue(bunka.string)
      		
        'porovnám zda došlo k chybě, musím dvakrát protože timevalue si taky může odskočit na chybu
        if chybicka = 0 then
          cas = timevalue(bunka.string)
        end if	

        if chybicka = 0 then						
          bunka.value = datum + cas
          bunka.NumberFormat = muj_format
        end if
      end if
			
      Hopsasa:

    next sloupec

  next radek
	
  print "počet neplatných formátů ve výběru: " & pocet_chyb
	
  chyba:
  chybicka = 1
  pocet_chyb = pocet_chyb + 1
  resume next	
		
End Sub

peterson864 · 27. 3. 2015 15:35:17

Díky.

lp. · 1. 4. 2015 12:14:04

Trochu jednodušší, trochu rychlejší

Sub prevod_data_format_alt()

  dim muj_format
  dim format_data as string
  dim dokument, bunka as object
  dim jazyk as new com.sun.star.lang.Locale

  dokument = ThisComponent
  pocet_chyb = 0

  'zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu		
  format_data = "D.M.YYYY H:MM:SS" 
  muj_format = dokument.NumberFormats.queryKey( format_data, jazyk, true )
  if (muj_format = - 1) then
    muj_format = dokument.getNumberFormats().addNew( format_data, jazyk )
  endif

  'vyber bude znamenat libovolně velký počet buněk, tedy nikoli jen jednu
  vyber = dokument.currentselection
  list = dokument.sheets(vyber.rangeaddress.sheet)
  
  with vyber.rangeaddress
    start_radek = .startrow
    start_sloupec = .startcolumn
    konec_radek = .endrow
    konec_sloupec = .endcolumn
  end with

  on error goto chyba
  for radek = start_radek to konec_radek
    for sloupec = start_sloupec to konec_sloupec
      bunka = list.getcellbyposition(sloupec, radek)
	  
      with bunka		
         If .string <> "" Then
            datum = CDate(.string)
            .value = datum
            .NumberFormat = muj_format
         end if
      end with
			
Hopsasa:
    next sloupec
  next radek

  on error goto 0                ' zrušíme zpracování chyby
  print "počet neplatných formátů ve výběru: " & pocet_chyb
  exit sub                       ' po ukončení cyklu není vhodné pokračovat chybovou rutinou
  	
chyba:                           ' jen počítá chyby a skočí na konec cyklu
  pocet_chyb = pocet_chyb + 1
  resume Hopsasa                 ' pokračujeme na konci cyklu
End Sub

ludviktrnka · 1. 4. 2015 17:01:35

Teď zas já děkuji. Třeba se takto časem naučím dokonce i programovat :-) Zatím jsem přeci jen z větší části zloděj hotových kódů.

Já jak jsem si to ještě tak ze srandy upravoval tak jsem tam na začátek ještě přidal ruční podmínku co vyloučí zbytečnou transformaci celého sloupce - přeci jen je to celkem pomalé a milión buněk už je celkem dost (ačkoli ještě jsem na celý sloupec nezkoušel tu úpravu dle LP)

pocet_bunek = (konec_radek - start_radek + 1) * (konec_sloupec - start_sloupec + 1)
if pocet_bunek > 10000 then
  dotaz = msgbox("Označených buněk je " & pocet_bunek & " Opravdu chcete spustit přepis?",4,"Ověření platnosti zvoleného rozsahu")
    if dotaz = 7 then
      exit sub
    end if
end if

A nebo by mohl někdo poradit jak makru říci, že už v celém sloupci dále není žádná vyplněná buňka tak ať klidně skončí.

Editoval ludviktrnka (1. 4. 2015 17:15:45)

ludviktrnka · 2. 4. 2015 14:38:42

myslím že se to už blíží dokonalosti :-) Přidal jsem zjištění počtu neprázdných buněk a tím omezení délky cyklu

Sub prevod_data_format()

	dim muj_format
	dim format_data as string
	dim dokument, vyber, list, bunka as object
	dim pocet_chyb, start_radek, konec_radek, start_sloupec, konec_sloupec, sloupec, radek, hotovo, pocet_bunek as integer
	dim datum, cas as date
	dim jazyk as new com.sun.star.lang.Locale

	dokument = ThisComponent

	pocet_chyb = 0
		
	format_data = "D.M.YYYY H:MM:SS" 'zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu
	muj_format = dokument.NumberFormats.queryKey( format_data, jazyk, true )
	if (muj_format = - 1) then
	muj_format = dokument.getNumberFormats().addNew( format_data, jazyk )
	endif

	vyber = dokument.currentselection 'vyber bude znamenat libovolně velký počet buněk, tedy nikoli jen jednu	
	list = dokument.sheets(vyber.rangeaddress.sheet)

	with vyber.rangeaddress
      start_radek = .startrow
      start_sloupec = .startcolumn
      konec_radek = .endrow
      konec_sloupec = .endcolumn
	end with
	
	pocet_bunek = vyber.computeFunction(com.sun.star.sheet.GeneralFunction.COUNT)
	
'	MsgBox "budem nahrazovat " & pocet_bunek & " buněk"

	on error goto chyba

	for sloupec = start_sloupec to konec_sloupec
	
		for radek = start_radek to konec_radek
			
			bunka = list.getcellbyposition(sloupec, radek)
						
		    with bunka		
       			If .string <> "" Then
           			datum = CDate(.string)
           			.value = datum
           			.NumberFormat = muj_format
           			hotovo = hotovo + 1
           		end if
  			end with
			if hotovo >= pocet_bunek then
   				goto Konec
   			end if	
Hopsa:

		next radek

	next sloupec
	
	on error goto 0	
Konec:
	MsgBox ("Počet neplatných formátů ve výběru: " & pocet_chyb, 0 ,"Informace")
	exit sub
	
chyba:
	hotovo = hotovo + 1
	pocet_chyb = pocet_chyb + 1
	resume Hopsa	
		
End Sub

lp. · 3. 4. 2015 10:24:12

To zjištění neprázdných buněk může vypadat jinak. Dalšího určité zrychlení se dá dosáhnout omezením přístupu k jednotlivým buňkám v listu. + Nějaké další drobnosti (sloučené buňky, ...)

Sub prevod_data_format()

  dim oDokument as object
  dim oVyber as object, oOblast as object

  dim jazyk as new com.sun.star.lang.Locale
  dim muj_format as string
  dim format_data as string

  dim pocet_chyb as long	

  pocet_chyb = 0

  oDokument = ThisComponent
  oDokument.lockControllers()	 ' Zakážeme obrazovku
  oDokument.addActionLock()	 ' Zakážeme přepočet

  ' zde mezi uvozovkami možno měnit formát data obdobně jako se to dělá u buňky v sešitu		
  format_data = "D.M.YYYY H:MM:SS" 
  muj_format = oDokument.NumberFormats.queryKey( format_data, jazyk, true )
  if (muj_format = - 1) then
    muj_format = oDokument.getNumberFormats().addNew( format_data, jazyk )
  endif

  oVyber = oDokument.getCurrentSelection()

  ' oVyber bude znamenat libovolně velký počet buněk, tedy nikoli jen jednu
  on error goto chyba                                   

  ' vybereme buňky s textem
  oVyber = oVyber.queryContentCells(com.sun.star.sheet.CellFlags.STRING)

'  Neprázdné buňky (podle gusta):
'  oVyber = oVyber.queryContentCells(_
'                      com.sun.star.sheet.CellFlags.VALUE OR _
'                      com.sun.star.sheet.CellFlags.DATETIME OR _
'                      com.sun.star.sheet.CellFlags.STRING OR _
'                      com.sun.star.sheet.CellFlags.FORMULA)
  on error goto 0

  pocetOblasti = oVyber.getCount

  if pocetOblasti > 0 then 
    for i = 0 to pocetOblasti - 1
      oOblast = oVyber.getByIndex(i)
      prevod_data_format_bloku oOblast, muj_format, pocet_chyb
    next

    print "počet neplatných formátů ve výběru: " & pocet_chyb
  End If

Konec:	
  oDokument.removeActionLock()	  ' Povolíme přepočet
  oDokument.unlockControllers()   ' Povolíme obrazovku

  Exit Sub

Chyba:
  Print "Není vybrána oblast buněk."
  on error goto 0
  resume Konec	
End Sub


Sub prevod_data_format_bloku(oVyber as object, muj_format as string, ByRef pocet_chyb as long)

  dim oList as object
  dim nRad as long, nSloupec as long
  dim oAdr		' adresa výběru
  dim datum 	

  oList = oVyber.Spreadsheet
  oAdr = oVyber.rangeaddress

  on error goto Chyba
  for nRad = oAdr.StartRow to oAdr.EndRow
    for nSloupec = oAdr.StartColumn to oAdr.EndColumn

      with oList.getcellbyposition(nSloupec, nRad)		
        If .String <> "" Then
          datum = CDate(.String)
          .Value = datum
          .NumberFormat = muj_format
        end if
      end with
			
Hopsasa:
      next nSloupec
    next nRad
    
Konec:
  on error goto 0                ' zrušíme zpracování chyby
  Exit Sub                       ' po ukončení cyklu není vhodné pokračovat chybovou rutinou
  	
Chyba:                           ' jen počítá chyby a skočí na konec cyklu
  pocet_chyb = pocet_chyb + 1
  resume Hopsasa                 ' pokračujeme na konci cyklu
End Sub

Editoval lp. (4. 4. 2015 17:52:57)

ludviktrnka · 3. 4. 2015 10:47:01

Tady se teď opravdu hodně přiučím ... dík moc.

OpenOffice.cz - web věnovaný kancelářským balíkům OpenOffice.org

#1 24. 3. 2015 00:05:55

Text do sloupců a makro - VYŘEŠENO

#2 24. 3. 2015 08:20:59

Re: Text do sloupců a makro - VYŘEŠENO

#3 24. 3. 2015 15:01:33

Re: Text do sloupců a makro - VYŘEŠENO

#4 24. 3. 2015 15:40:47

Re: Text do sloupců a makro - VYŘEŠENO

#5 24. 3. 2015 18:46:29

Re: Text do sloupců a makro - VYŘEŠENO

#6 24. 3. 2015 19:14:08

Re: Text do sloupců a makro - VYŘEŠENO

#7 24. 3. 2015 20:00:39

Re: Text do sloupců a makro - VYŘEŠENO

#8 24. 3. 2015 20:10:42

Re: Text do sloupců a makro - VYŘEŠENO

#9 27. 3. 2015 09:07:00

Re: Text do sloupců a makro - VYŘEŠENO

#10 27. 3. 2015 15:35:17

Re: Text do sloupců a makro - VYŘEŠENO

#11 1. 4. 2015 12:14:04

Re: Text do sloupců a makro - VYŘEŠENO

#12 1. 4. 2015 17:01:35

Re: Text do sloupců a makro - VYŘEŠENO

#13 2. 4. 2015 14:38:42

Re: Text do sloupců a makro - VYŘEŠENO

#14 3. 4. 2015 10:24:12

Re: Text do sloupců a makro - VYŘEŠENO

#15 3. 4. 2015 10:47:01

Re: Text do sloupců a makro - VYŘEŠENO

Zápatí