MS Excel

Téma: Součet vyhledaných hodnot

Zaslal/a Richard.M 24.6.2014 7:50

Dobrý den,
mám ve VBA kód na vyhledávání hodnot v kusovníku. Vše to fungu, ale jen pro situaci, že se v kusovníku objevuje položka jen jednou. Potřeboval bych to udělat tak, že pokud vyhledávací funkce najde ve sloupci E hodnotu "a" ve více řádcích, sečte hodoty (počty kusů) ve sloupci G těchto řádků.
Děkuji za případné návrhy.
S pozdravem R.M.

roz4 = Sheets("Pomoc").Cells(Rows.Count, "A").End(xlUp).row
For i = 1 To roz4

'načte číslo součásti z kusiovníku
a = Worksheets("Pomoc").Range("A" & i).Value
'načte počet kusú z kusovníku
'b = Workbooks(jm).Worksheets("Stahl").Range("F" & i).Value
b = Worksheets("Pomoc").Range("C" & i).Value
'načte hmotnost kusú z kusovníku
cc = Worksheets("Pomoc").Range("B" & i).Value

'Workbooks(jm3).Close savechanges:=False

Sheets(jm1).Activate
roz2 = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

With Range("E16:E" & roz2)

Set FoundCell = .Cells.Find(What:=a, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

End With
If FoundCell Is Nothing Then
roz3 = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row
'MsgBox ("roz3=" & roz3)
roz4 = roz3 + 1
Range("E" & roz4) = a
Range("F" & roz4) = cc
Range("G" & roz4) = b

Range("E" & roz4 & ":G" & roz4).Interior.Color = Barva

roz2 = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row
'MsgBox ("roz2=" & roz2)

Else

FoundCell.Select
Dim col, row
col = Split(Selection.Address, "$")(1)
row = Split(Selection.Address, "$")(2)
'MsgBox "Column is : " & col
'MsgBox "Row is : " & row

'načte počet kusu v megakusovniku
c = Range("G" & row).Value

If c = b Then
'nedělej nic
Else

Range("G" & row) = b
Range("G" & row).Interior.Color = Barva

End If

'MsgBox "Nalezeno :) " & FoundCell.Address
' tady proveď požadavanou akci nebo
' tady to smaž je jen pro ověření
End If

Next i

Zaslat odpověď >

eLCHa(24.6.2014 10:11)#020080

Je pěkné, že jste nám tu vložil ten kód, ale je to k ničemu (mluvím za sebe). Příloha by byla lepší.
Nicméně, tak jak jste to napsal je řešení jednoduché
fce SUMIF (COUNTIF) volaná pomocí VBA
Application.WorksheetFunctions.SumIf(Range("Ex:Ey"),"a", Range("Gx:Gy"))citovat

AL(24.6.2014 11:01)#020081

V podstate súhlasím s eLCHa, malá oprava uvedenej inštrukcie, ktorá v tvare uvedenom eLCHa pmn fungovať nebude:Application.WorksheetFunction.SumIf(Range("E" & x & ":E" & y), a, Range("G" & x & ":G" & y)), kde x a y sú riadky od-do.
Pokiaľ som pochopil originálny kód, tak v prípade, že nájde v kusovníku novú položku, tak pre ňu zakladá nový riadok vo výsledku. Čiže najprv založiť záznamy pre nové položky kusovníku a následne aplikovať sumify....citovat

eLCHa(24.6.2014 11:22)#020082

@AL ;))))
Je možné že nebude, protože jsem to psal z brucha (pravda, nepatří WorksheetFunctions ale WorksheetFunction) - omluva

Jen na vysvětlení - pokud jste to nepochopil vy, tak asi ani ostatní:
a by určitě mělo být v uvozovkách ;))
ve sloupci E hodnotu "a" ve více řádcích

To x a y bych dal diakritikou, ale to tady bohužel nelze, když je to zároveň kód (nebylo myšleno jako proměnná, ale jako náhrada za číslo ;))).citovat

AL(24.6.2014 11:28)#020083

@eLCHa: a by určitě mělo být v uvozovkách ;))
nene, a je v originálnom kóde premennou, takže žiadne uvodzovky, ale ono skutočne záleží na tom, ako je čo myslené....

edit: aha, tak beriem späť, špatne som videl asi, a je skutočne reťazec, takže samozrejme, máte pravdu, má byť v uvodzovkách, v premennej a je v kóde niečo iné, nie identifikátor položky kusovníku...citovat

R.M(24.6.2014 14:41)#020090

Díky všem, funguje to bezvadně.

citovat

Uživatelské menu

Nejste přihlášen(a)

Formulář Faktura

Formulář Faktura IV

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

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.