< návrat zpět

MS Excel


Téma: Reference na buňku rss

Zaslal/a 8.1.2021 18:50

Ahoj,
prosím o radu. Mám následující kód:

Option Explicit
Function ColorMath(InputRange As Range, ReferenceCell As Range, Optional Action As String = "S", Optional Area As String)

Application.Volatile

Dim ReferenceColor As Long
Dim CellCount As Long
Dim Result As Variant
Dim Cell As Range

Action = UCase(Action)
Result = 0
CellCount = 0
ReferenceColor = ReferenceCell.Interior.Color

If Action = "S" Or Action = "A" Then

For Each Cell In InputRange

If Cell.Interior.Color = ReferenceColor And Cell.Offset(0, -11).Value = Area Then

Result = Result + Cell.Value
CellCount = CellCount + 1

End If
Next Cell
End If

If Action = "C" Then
For Each Cell In InputRange
If Cell.Interior.Color = ReferenceColor Then Result = Result + 1
Next Cell
End If

If Action = "A" Then
Result = Result / CellCount
End If

ColorMath = Result
End Function

Kde se odkazuju offsetem na buňku o 11 míst vlevo. Toto nicméně funguje pouze pro jeden sloupec (z různých sloupců se vždy odkazuju do sloupce F). Jakmile se tedy cell změní na jiný, tak je to -12, -13, -14...

Chtěl bych poprosit o radu, jak se odkazovat vždy na buňku na příslušném řádku ve sloupci F bez tohoto nehezkého offsetu.
Předem díky

Zaslat odpověď >

#049410
avatar
Cells(Cell.Row, 6)citovat
#049447
avatar
Možná místo Row bylo myšleno Column? Každopádně ani s jedním logika není funkční 4 .

Nenašla by se nějaká dobrá duše co by na to hodila oko? Jde o vytvoření nové funkce ColorMath, která na záložce souhrn zobrazuje průměr hodnot ze záložky Vše a to na základě podbarvení buňky + typu kategorie.

Současně je celý workbook při jakékoliv změně (i formátování) zalagovaný, přestože je tam zatím pouze zlomek dat pro potřeby testu.

https://webshare.cz/#/group/o2eimoKZz3/citovat
#049448
avatar

Blahic napsal/a:

Možná místo Row bylo myšleno Column? Každopádně ani s jedním logika není funkční .

Nie. Row znamená "aktuálny riadok" a 6 je stĺpec F.
A čo ti tu budeme riešiť, keď nedáš súbor?citovat
#049451
elninoslov
Nepočítajte s celými stĺpcami, radšej ich vypočítajte.
=ColorMath(OFFSET(Vše!$A$2;;MATCH(B$1;Vše!$1:$1;0)-1;COUNTA(Vše!$A:$A)-1);$K$1;"S";OFFSET(Vše!$F$2;;;COUNTA(Vše!$A:$A)-1);$A2)
=ColorMath(POSUN(Vše!$A$2;;POZVYHLEDAT(B$1;Vše!$1:$1;0)-1;POČET2(Vše!$A:$A)-1);$K$1;"S";POSUN(Vše!$F$2;;;POČET2(Vše!$A:$A)-1);$A2)

Nechce sa mi overovať, ale tipujem, že tom Cell.Offset(0, -11) alebo v tom Cells(Cell.Row, 6) nepočítate s listom dát, ale s listom súhrnu, páč je to volané z neho.
Kód +- autobus ... :
Option Explicit
Function ColorMath(InputRange As Range, ReferenceCellColor As Range, Optional Action As String = "S", Optional ConditionalRange As Range, Optional ConditionalValue)
' Action can be S to SUM, A to AVERAGE, or C to COUNT
' If not specified the default Action is SUM

Dim bIsConditional As Boolean, i As Long, bIsOK As Boolean
Dim Cell As Range, ReferenceColor As Long, CellCount As Long, Result As Variant

Application.Volatile 'Automatické přepočítání při jakékoliv změně v buňkách



Action = UCase(Action) 'Konverze zadaného typu výpočtu do upercase
Result = 0
CellCount = 0
ReferenceColor = ReferenceCellColor.Interior.Color 'Zadefinování proměnné pro referenční barvu
bIsConditional = Not ConditionalRange Is Nothing 'Zjištění přítomnosti další podmínky

For Each Cell In InputRange
i = i + 1 'Index pro další podmínku
If Cell.Interior.Color = ReferenceColor Then 'Kontrola barvy
bIsOK = True 'Barva sedí, zatím je to OK
If bIsConditional Then bIsOK = ConditionalRange(i).Value = ConditionalValue 'Když je další podmínka, zkontroluj a uprav OK/NOK
If bIsOK Then 'Když je to OK i po další podmínce
CellCount = CellCount + 1 'Inkrementace Počet (potřebné pro COUNT i AVERAGE)
Select Case Action
Case "A", "S": Result = Result + Cell.Value 'A když se jedná o AVERAGE nebo SUM, tak připrav součet
End Select
End If
End If
Next Cell

If CellCount > 0 Then 'Máme na konci nějaké OK?
Select Case Action
Case "A": Result = Result / CellCount 'Typ výpočtu pro AVERAGE
Case "C": Result = CellCount 'Typ výpočtu pro COUNT
End Select 'Typ výpočtu pro SUM už je hotov v předešlým cyklu
End If

ColorMath = Result
End Function

Keď sa mi bude chcieť, urobím aj verziu s poľom dát, možno bude rýchlejšia. Farbu bude treba bunku po bunke kontrolovať, to je jasné, ale hodnotu bunky a podmienku už by si načítal z poľa.
Příloha: zip49451_test.zip (21kB, staženo 11x)
citovat
#049456
elninoslov
Tak na rýchlo tá verzia s poľom:
Option Explicit
Function ColorMath(InputRange As Range, ReferenceCellColor As Range, Optional Action As String = "S", Optional ConditionalRange As Range, Optional ConditionalValue)
' Action can be S to SUM, A to AVERAGE, or C to COUNT
' If not specified the default Action is SUM

Dim aInput(), aCR()
Dim bIsConditional As Boolean, x As Integer, y As Long, bIsOK As Boolean
Dim Cell As Range, ReferenceColor As Long, CellCount As Long, Result As Variant

Application.Volatile 'Automatické přepočítání při jakékoliv změně v buňkách

If InputRange.Cells.Count = 1 Then 'Načtení hodnot z buněk kontrolované oblasti do pole
ReDim aInput(1 To 1, 1 To 1)
aInput(1, 1) = InputRange.Value
Else
aInput = InputRange.Value
End If

If Not ConditionalRange Is Nothing Then 'Zjištění přítomnosti další podmínky
bIsConditional = True
If ConditionalRange.Rows.Count = 1 Then 'Načtení hodnot z buněk oblasti další podmínky do pole
ReDim aCR(1 To 1, 1 To 1)
aCR(1, 1) = ConditionalRange.Columns(1).Value
Else
aCR = ConditionalRange.Columns(1).Value
End If
End If

Action = UCase(Action) 'Konverze zadaného typu výpočtu do upercase
Result = 0
CellCount = 0
ReferenceColor = ReferenceCellColor.Interior.Color 'Zadefinování proměnné pro referenční barvu

For y = 1 To UBound(aInput, 1)
For x = 1 To UBound(aInput, 2)
If InputRange.Cells(y, x).Interior.Color = ReferenceColor Then 'Kontrola barvy
bIsOK = True 'Barva sedí, zatím je to OK
If bIsConditional Then bIsOK = aCR(y, 1) = ConditionalValue 'Když je další podmínka, zkontroluj a uprav OK/NOK
If bIsOK Then 'Když je to OK i po další podmínce
CellCount = CellCount + 1 'Inkrementace Počet (potřebné pro COUNT i AVERAGE)
Select Case Action
Case "A", "S": Result = Result + aInput(y, x) 'A když se jedná o AVERAGE nebo SUM, tak připrav součet
End Select
End If
End If
Next x
Next y

If CellCount > 0 Then 'Máme na konci nějaké OK?
Select Case Action
Case "A": Result = Result / CellCount 'Typ výpočtu pro AVERAGE
Case "C": Result = CellCount 'Typ výpočtu pro COUNT
End Select 'Typ výpočtu pro SUM už je hotov v předešlým cyklu
End If

ColorMath = Result
End Function
Příloha: zip49456_test-pole.zip (22kB, staženo 13x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09