Excel 2010 výpočet bunky s farebný pismom
Ahoj,
Prosím o radu,
potrebujem zrátať dve číselné bunky, ale s tým že ak budú čísla v tých bunkách napísané červenou farbou tak ich výsledok bude 0 (nula), ak budú inou farbou tak budú sčítané normálne.
Ďakujem.
Prosím o radu,
potrebujem zrátať dve číselné bunky, ale s tým že ak budú čísla v tých bunkách napísané červenou farbou tak ich výsledok bude 0 (nula), ak budú inou farbou tak budú sčítané normálne.
Ďakujem.
Dělá se to ve VBA.
[code]
If Selection.Font.Color = vbRed Then
Barva písma je červená
Else
Barva písma není červená.
End If
[/code]
[code]
If Selection.Font.Color = vbRed Then
Barva písma je červená
Else
Barva písma není červená.
End If
[/code]
Prosím Ťa nemôžeš mi to napísať do priloženého súboru? Ak by to išlo.
Bol by som Ti fakt vďačný.
Ďakujem.
[ATTACH]29609[/ATTACH]
Bol by som Ti fakt vďačný.
Ďakujem.
[ATTACH]29609[/ATTACH]
Založ sešit s makry, pokud nemáš, vlož kartu Vývojář, založ nové makro a do něj zkopíruj
[code]
Sub Prepis()
Dim PocetRadku
Dim PocetSloupcu
Dim i
Dim ii
PocetSloupcu = 30 'Predpokladany pocet sloupcu
Range("A1").Select 'Nejvice obsazeny sloupec a radek odkud zacinaji data
'PocetRadku = ActiveSheet.Cells(1).CurrentRegion.Rows.Count 'Pocet obsazenych radku
'Horni radek se da pouzit pouze, pokud je sloupec obsazen bez mezer!
'Jinak se počet sloupců musí zadat rucne.
PocetRadku = 30
Range("A1").Select 'Vrat se na zacatek
For i = 1 To PocetRadku 'Posouva po radcich
For ii = 1 To PocetSloupcu 'posouva po sloupcich
If Selection.Font.Color = vbRed Then 'Pokud je cervena, zapis nulu
ActiveCell.Value = 0 'Zapise nulu
Selection.Font.Color = vbBlack 'Zmen barvu na cernou
End If
ActiveCell.Offset(0, 1).Range("A1").Select 'Posun o jedno doprava
Next ii
ActiveCell.Offset(1, -30).Range("A1").Select 'Posun o jedno dolů a 30 doleva
Next i
End Sub
[/code]
Potom už stačí pustit makro.
[code]
Sub Prepis()
Dim PocetRadku
Dim PocetSloupcu
Dim i
Dim ii
PocetSloupcu = 30 'Predpokladany pocet sloupcu
Range("A1").Select 'Nejvice obsazeny sloupec a radek odkud zacinaji data
'PocetRadku = ActiveSheet.Cells(1).CurrentRegion.Rows.Count 'Pocet obsazenych radku
'Horni radek se da pouzit pouze, pokud je sloupec obsazen bez mezer!
'Jinak se počet sloupců musí zadat rucne.
PocetRadku = 30
Range("A1").Select 'Vrat se na zacatek
For i = 1 To PocetRadku 'Posouva po radcich
For ii = 1 To PocetSloupcu 'posouva po sloupcich
If Selection.Font.Color = vbRed Then 'Pokud je cervena, zapis nulu
ActiveCell.Value = 0 'Zapise nulu
Selection.Font.Color = vbBlack 'Zmen barvu na cernou
End If
ActiveCell.Offset(0, 1).Range("A1").Select 'Posun o jedno doprava
Next ii
ActiveCell.Offset(1, -30).Range("A1").Select 'Posun o jedno dolů a 30 doleva
Next i
End Sub
[/code]
Potom už stačí pustit makro.
