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

#1 27. 4. 2024 00:10:14

tanner5
Člen
Registrace: 18. 4. 2020
Příspěvků: 52

Sčítání buněk podle barvy pozadí - VYŘEŠENO

Zdravím,
potřeboval bych poradit jak sečíst buňky podle barevného pozadí i v případě změny.
Vím, že se to tu řešilo, tuším pan Neutr a Lader, ale bohužel , odkazy na soubory na ulož.to nefungují.
Neměl by je někdo k dispozici prosím?
Moc děkuji

Editoval tanner5 (27. 4. 2024 05:48:06)

Offline

#2 27. 4. 2024 05:35:14

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

Re: Sčítání buněk podle barvy pozadí - VYŘEŠENO

Něco podobného jsem dělal, ale jenom to oznamovalo počet buněk. Takže jsem se podíval na makro a upravil tak aby sčítalo.


     Nejprve se musí vybrat oblast a zapamatovat si která buňka má správnou barvu pro podklad. Spustí se makro a do dialogu se napíše buňka s podkldem, který se má vyhodnocovat. Výsledek se objeví jako komentář v označené buňce. Z toho lze výsledek kopírovat a nakonec komentář jednoduše smazat. Šlo by to i jinak, ale pokud Vám to stačí, není potřeba dále upravovat. Jenom si musíte pamatovat postup - vybrat oblast, zapamatovat si vzorovou buňku a spustit makro.

Sub NumberColorTestCells()
Dim oCell As Object 
oCell = ThisComponent.CurrentController.getSelection() 
With oCell.RangeAddress 
SH = .Sheet 
SC = .StartColumn 
SR = .StartRow
EC = .EndColumn 
ER = .EndRow
End With 

oSheet = ThisComponent.Sheets(SH)
TestCell = InputBox("Zadej buňku která obsahuje vzor pro předem vybranou oblast. Zápis se provede " & _ 
"do buňky ve formě komentáře","SOUČET VYBRANÉHO ÚSEKU","A1") 
barva = oSheet.getCellRangeByName(TestCell).CellBackColor
pismo = oSheet.getCellRangeByName(TestCell).CharColor

MyCell = oSheet.getCellRangeByName(TestCell) 
With MyCell.RangeAddress 
SH = .Sheet 
CC = .StartColumn 
RR = .StartRow
End With 

WorkCell = oSheet.getCellByPosition(CC,RR +1)

For i = SC To EC
	For j = SR To ER
		If oSheet.getCellByPosition(i,j).CellBackColor = barva Then
			IF oSheet.getCellByPosition(i,j).CharColor = pismo Then
				cCount = cCount + 1 
				rCount = rCount + 1
				sCount = sCount + oSheet.getCellByPosition(i,j).Value
			End If
		End If
	Next j
Next i

WorkCell.Value = cCount

sVar = "Barva pozadí 	= " & barva & Chr(10) & "počet výskytů 	= " & cCount & Chr(10) & Chr(10)
sVar = sVar & "Barva písma  	= " & pismo & Chr(10) & "počet výskytů 	= " & rCount & Chr(10) & Chr(10)
sVar = sVar & "Součet  	= " & sCount

SheetAnnotations = oSheet.annotations
AnnotationCell = Mycell 
SheetAnnotations.insertNew(AnnotationCell.cellAddress, sVar)
AnnotationCell.annotation.isVisible = true
End Sub

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 27. 4. 2024 05:47:36

tanner5
Člen
Registrace: 18. 4. 2020
Příspěvků: 52

Re: Sčítání buněk podle barvy pozadí - VYŘEŠENO

Převelice děkuji, takto je to úplně dostačující.

Offline

Zápatí