Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 18. 4. 2016 16:35:18

vikinx
Člen
Registrace: 24. 1. 2015
Příspěvků: 36

MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Opet resim maly problem: jak makrem prepsat cca 40 oblasti bunek stejnou hodnotou napr. "1". Dohromady je to neco pres 1200 bunek. Ma to malou vyhodu: co oblast, to jen 1 sloupec, ale ruzny pocet radku.


Momentalne to resim ulozenim jednotlivych nazvu do array a pres cyklus: zjisteni adresy oblasti a prepsani kazde bunky. A ted ten problem: pokud to pustim na listu, kde dochazi ke zmene, bezi to trosku pomaleji nez bych si predstavoval, chapu 1200 bunek neni malo, ale slape to...
Ale pokud to pustim z jineho listu (coz potrebuji), LO bez udani duvodu spadne. Muze to byt tim zanorenym cyklem?


Poradite, prosim, cim by to mohlo byt? Prip. nejake lepsi reseni jak toto resit?


EDIT: upravovane bunky nabyvaji hodnoty: 0 a 1

Sub SetZero
	oStorageSheet = ThisComponent.Sheets.GetByName("Sheet3")
	Dim MyArray(1 To 2) As String
	MyArray(1) = "oblast01"
	MyArray(2) = "oblast02"
		For i = 1 To UBound(MyArray)
			oCells = SplitString(GetRangeAddress(MyArray(i))(0),".",2)
			oRowStart = GetRangeAddress(MyArray(i))(1)
			oRows = GetRangeAddress(MyArray(i))(2)-oRowStart+1
			oColumn = Mid(oCells, 2, 1)
				For n = 1 To oRows
					oRow = oRowStart + n
					oCellTarget = oStorageSheet.GetCellRangeByName(oColumn & oRow)
						If oCellTarget.Value > 0 Then
							oCellTarget.Value = 0
						End If
				Next n
		Next i
End Sub	

Sub GetRangeAddress(oRange As String) As Array
	Dim r As Object
	Dim rAddress as New com.sun.star.table.CellRangeAddress
	r = ThisComponent.NamedRanges.getByName(oRange).ReferredCells
	rAddress = r.RangeAddress
	GetRangeAddress = array(r.AbsoluteName, rAddress.StartRow, rAddress.EndRow)
End Sub

Function SplitString(oString, Separator, Rank)
	Rank = Rank-1
	Items = Split(oString, Separator)
		If Rank < 0 OR Rank > UBound(Items) Then 
			SplitString = ""
		Else
			SplitString = Items(Rank)
		End If	
End Function

Editoval vikinx (1. 5. 2016 19:11:33)

Offline

#2 18. 4. 2016 17:55:53

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,468

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Všechno to vypadá dost divně. Například :
Dim MyArray(1 To 2) As String
    MyArray(1) = "oblast01"
    MyArray(2) = "oblast02"
     Tohle má trošku význam jen pokud je "oblast01" a "oblast02" názvem oblasti - například pojmenovaný úsek. Jenomže pak je deklarace MyArray úplně zbytečná. Stačilo by
Dim oblast01, oblast02 as object (respektive variant) a nebo v určitém případě vůbec nic.
     Navíc takhle jednoduchá pole se zadává nejspíš takto :
Dim MyArray(1) As String
    MyArray(0) = "oblast01"
    MyArray(1) = "oblast02"
     Nebo přímo jako getByIndex(SC, SR, EC, ER) a pak by to bylo například takto :
Dim MyArray(1)
    MyArray(0) = array(SC1, SR1, EC1, ER1)
    MyArray(1) = array(SC2, SR2, EC2, ER2)
Ale i pak by bylo asi lepší nadefinovat hned celou adresu - při dvou by se takto nic neušetřilo - spíš naopak - bylo by více kódu.


     Další věc :
For i = 1 To UBound(MyArray)
            oCells = SplitString(GetRangeAddress(MyArray(i))(0),".",2)
... Doplňte si za ten výraz Myarray a dostanete například :
           oCells = SplitString(GetRangeAddress("oblast01")(0),".",2)
....oCells se tváří jako "adresa buňky", ale je to String který k výrazu oblast01 přidá tečku jako separátor a něco - například XY - tedy získáte výraz "oblast01.XY"



    Podobně také
oRowStart = GetRangeAddress("oblast01")(1)
     Poroblém je v tom, že "startovní řádek" (tedy oRowStart) už by měl být deklarovaný číslem, ale když voláte oblast01 tak je to celý název oblasti - pokud to není jen jediná buňka. To zase koliduje s tím že voláte v jiných případech ten samý úsek a proto to není jediná buňka (a doufejme že jde o explicitní název oblasti sešitu vedené v rámci databázového úseku, nebo pojmenované oblasti).
     Podobně všechno ostatní. Silně pochybuji že by to vůbec chodilo a natož potom "pomalu, ale správně" z toho konkrétního sešitu. Tohle se dělá jinak


     Najdete poslední řádek každého sloupce - (startovní znáte). To jsou čísla, která dáte jako proměnné - například SR a ER - deklarace jako Long.
Dim Sheet, Doc
Sheet = ThisComponent.GetSheets(3)
     Cyklus pak spouštíte For i = SR TO ER. Vlastní buňky pak mají deklaraci číslem
například
Cell = Sheet.GetCellRangeByposition(SC, i)
Dotaz :
IF Cell.String = XYZ Then
...něco
End If
Next i
Další sloupec
SR = něco, ER = něco, SC = něco (to je číslo sloupce - jak StartColumn)
a zase

For i = SR TO ER.
Cell = Sheet.GetCellRangeByposition(SC, i)
IF Cell.String = XYZ Then
...něco
End If
Next i

Osobně bych to řešil funkcí

Function IterujPotvoro(ByVal SC as long, ByVal SR as long, ByVal ER as long, ByVal sVar as string)
Dim Doc, Sheet
Cell = sheet.GetCellRangeByposition(SC, i)
IF Cell.String = XYZ Then
Cell.string = Cell.string & "." & sVar
End If
End Function

Tahle funkce by se spouštěla nějakým makrem které by přežvejkalo kde se má iterovat a co se bude přidávat k původnímu výrazu a podobně. Já to píšu samozřejmě z hlavy takže takhle to chodit asi nebude. Váš celý problém je v určení posledního řádku inkriminovaného sloupce. Na to se dá postavit makro, nebo funkce, nebo se to dá i nahrát záznamníkem.


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#3 18. 4. 2016 18:16:49

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,468

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Našel jsem něco co by Vám asi pomohlo:

sub CisPoslRadkuNaSloupu()
Dim oDoc As Object
dim lastRow as Long
dim oSheet as object
dim oCol,rd,find,aray
oDoc = ThisComponent
oSheet = oDoc.Sheets().getByName("List2")
'oSheet = oDoc.Sheets().getByIndex(1) 'Alternativní určení sešitu číslem
oCol = oSheet.getColumns().getByIndex(10)
rd = oCol.createReplaceDescriptor
rd.searchRegularExpression = true
rd.setSearchString(".")
find = oCol.FindAll(rd)
aray = Split(find.AbsoluteName,"$")
lastRow = aray(ubound(Aray))
    'Print lastRow ' tohle dává hlášku
end sub

     Makro zahrnuje nahrazování ale také hledání posledního řádku. Když zadáme správné parametry tak to může pracovat jako nalezení posledního řádku bez nahrazení. Ale myslím že vy hledáte právě podobnou funkci k nalezení a nahrazení něčeho co pak "doplníte".


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#4 18. 4. 2016 18:18:52

vikinx
Člen
Registrace: 24. 1. 2015
Příspěvků: 36

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Funguje to, to vim. Bylo to otestovano na mensim mnozstvi oblasti.

Uz asi vim, kde je zakopan pes:

oColumn = Mid(oCells, 2, 1)

- bere v potaz jen 1-pismenne sloupce :-/


PS: Posledni radek hledat nemusim: GetRangeAddress ho vraci jako 3. argument

Editoval vikinx (18. 4. 2016 18:21:21)

Offline

#5 19. 4. 2016 00:40:48

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 844

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Zkuste něco takového. Mělo by to být trochu rychlejší.


Sub SetZero
	dim oblast as object 
	dim nuly() as variant  
	dim k as long, l as long
	
	oStorageSheet = ThisComponent.Sheets.GetByName("List3")
	Dim MyArray(1 To 2) As String
	MyArray(1) = "oblast01"
	MyArray(2) = "oblast02"

	ThisComponent.enableAutomaticCalculation(False)    ' vypne přepočet

	For i = 1 To UBound(MyArray)
		set oblast = oStorageSheet.GetcellRangebyname(MyArray(i))
		nuly = oblast.dataarray
		for k = lbound(nuly,1) to ubound(nuly,1)
			for l = lbound(nuly(k),1) to ubound(nuly(k),1)
				if nuly(k)(l) > 0 then nuly(k)(l) = 0
			next l
		next k
		oblast.dataarray = nuly
	Next i
	
	ThisComponent.enableAutomaticCalculation(True)    ' zapne přepočet
End Sub	

Editoval lp. (21. 4. 2016 00:29:01)

Offline

#6 19. 4. 2016 20:10:47

vikinx
Člen
Registrace: 24. 1. 2015
Příspěvků: 36

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Diky, je to mnohem rychlejsi... Ale funkcnost - data jsou opravdu prepsana, ale na tyto prepisovane bunky jsou vazane podminky, ktere stale berou puvodni hodnotu.


Nevis cim to muze byt? Zkusil jsem re-open, jestli pobezi, ale tvari se to, jako by se neprepsaly. Pokud potom prepisi rucne, podminky uz se nehnou :-/


Diky


PS: jeste jsem se s tim nesetkal, ale prestanou fungovat vsechny podminky v celem dokumentu. Mozna toho nebude fungovat vice, ale nic proti tomu nepomohlo. Jeste, ze jsem mel zalohu ;-)

Editoval vikinx (19. 4. 2016 20:16:08)

Offline

#7 19. 4. 2016 20:32:39

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,468

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Podívejte se na přepočítávání buněk. Někdy se stane, že se autamatické přepočítávání vypne. No a pak by se dělo to co popisujete. Je tady na fóru i nějaké makro - tuším právě od "lp." na přepočítání, nebo asi zapnutí přepočtu.


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#8 19. 4. 2016 22:20:59

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 844

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

vikinx napsal(a)

Diky, je to mnohem rychlejsi... Ale funkcnost - data jsou opravdu prepsana, ale na tyto prepisovane bunky jsou vazane podminky, ktere stale berou puvodni hodnotu.


Nevis cim to muze byt? Zkusil jsem re-open, jestli pobezi, ale tvari se to, jako by se neprepsaly. Pokud potom prepisi rucne, podminky uz se nehnou :-/

Omlouvám se, překlep. Na konci má být

ThisComponent.enableAutomaticCalculation(True)

(Na začátku se automatický přpočet vypíná, pak se má zapnout.)

Offline

#9 19. 4. 2016 22:33:07

vikinx
Člen
Registrace: 24. 1. 2015
Příspěvků: 36

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Mne to napadlo, ze to bude ono, ale radsi jsem se zeptal... Tuto funkci ale bohuzel vubec neznam. Clovek se stale uci ;-)


Diky moc

Offline

#10 1. 5. 2016 19:11:08

vikinx
Člen
Registrace: 24. 1. 2015
Příspěvků: 36

Re: MAKRO: Prepsani bunek v nekolika oblastech stejnou hodnotu - VYRESENO

Tak konecne jsem se dostal odzkouset, funguje perfektne a hlavne rychle...


2 lp.: jeste jednou diky ;-)



PS: vyreseno

Offline

Zápatí