MS Excel

Téma: VBA a kopírování funkce do dalšího řádku

Zaslal/a Pepa02 3.12.2023 0:08

Prosím o radu. Jak udělat, pokud najdu hodnotu aaa ve více řádcích, aby se vzorec posunul o potřrbný počet

B15 je aaa proto je ve F15 funkce =SUMIFS($E$15:E15;$B$15:B15;$I$2) - funguje správně
B17 je aaa proto je ve F17 funkce =SUMIFS($E$15:E17;$B$15:B17;$I$2) - nedokážu nastavit posun ve vzorci

Tj. jak udělám posum ve vzorci?

Děkuji za pomoc

Sub TEST_kopie()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range

' Nastavíme sešit
Set ws = ThisWorkbook.Sheets("TEST")

' Nastavíme rozsah pro procházení
Set rng = ws.Range("B15:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)

' Projdeme buňky v rozsahu
For Each cell In rng
' Pokud buňka obsahuje hodnotu "aaa", zkopírujeme funkci z buňky L7 do sloupce F
If cell.Value = "aaa" Then
ws.Cells(cell.Row, "F").FormulaLocal = "=SUMIFS($E$15:E15;$B$15:B15;$I$2)"
End If
Next cell
End Sub

Zaslat odpověď >

elninoslov(3.12.2023 8:20)#055737

Vo Vašom príklade bude stačiť
"=SUMIFS($E$15:E" & cell.Row & ";$B$15:B" & cell.Row & ";$I$2)"
ale je to to najpomalšie riešenie, chodí po 1 bunke. Lepšie riešenie by bolo cez pole a vloženie vzorca naraz do oblasti. Viete si také urobiť, či mám Vám to spichnúť?

EDIT:
Podľa vzorca, je tá hľadaná hodnota v I2, nie?
Pridávam spomínané makro.
Sub pokus()
Dim B(), i As Long, y As Long, Prvni As Long, Radku As Long, rng As Range, Hledane

Const PRVNI_RADEK_DAT As Long = 15

With ThisWorkbook.Sheets("TEST")
Radku = .Cells(Rows.Count, "B").End(xlUp).Row - PRVNI_RADEK_DAT + 1

If Radku < 1 Then MsgBox "Žádné data v sloupci B", vbCritical: Exit Sub
If Radku = 1 Then ReDim B(1 To 1, 1 To 1): B(1, 1) = .Cells(PRVNI_RADEK_DAT, "B").Value Else B = .Cells(PRVNI_RADEK_DAT, "B").Resize(Radku).Value

Hledane = .Range("I2").Value
If IsEmpty(Hledane) Then MsgBox "Buňka s hledanou hodnotou I2 je prázdná", vbCritical: Exit Sub

For i = 1 To Radku
If B(i, 1) = Hledane Then
y = i + PRVNI_RADEK_DAT - 1
If rng Is Nothing Then Set rng = .Cells(y, "F"): Prvni = y Else Set rng = Union(rng, .Cells(y, "F"))
End If
Next i
End With

If Not rng Is Nothing Then rng.FormulaLocal = "=SUMIFS($E$15:E" & Prvni & ";$B$15:B" & Prvni & ";$I$2)"
End Sub
No poznámky:
Stačilo by použiť vzorec SUMIF, netreba SUMIFS.
Stačilo by mať v F na dostatočnú výšku tento vzorec, a nepotrebujete žiadne makro.
=IF($B15=$I$2;SUMIF($B$15:$B15;$I$2;$E$15:$E15);"")
=KDYŽ($B15=$I$2;SUMIF($B$15:$B15;$I$2;$E$15:$E15);"")

Příloha: zip

55737_pokus-vloz-vzorec.zip (13kB, staženo 3x)

citovat

Téma: VBA a kopírování funkce do dalšího řádku

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje