Makro ob enakem podatku sešteje količine

[tjazma]

Pozdravljeni,
Imam makro kateri iz Lista 1 prenaša (kopira) podatke v tabelo na List2 (sheet "Obrazec") in sicer v prvo naslednjo spodnjo vrstico. Vse lepo dela.
Ob pogoju, da podatek (koda artikla) v celeci "A15" obstaja se pravi je enak, bi želel, da podatek ne prenese v drugo vrstico ampak količino sešteje (združi).


sheets("OBRAZEC").Select

ActiveSheet.Unprotect

If ActiveSheet.Range("a10").Value = "" Then
ActiveSheet.Range("A10:B10").Value = Sheets("LIST1").Range("E6:F6").Value
Else
ActiveSheet.Range("a42").End(xlUp).Range(Cells(10, 1), Cells(10, 2)).Value = Sheets("LIST1").Range("E6:F6").Value
End If

ActiveSheet.Protect

Najlepša hvala za odgovore.

[admin]

Da bi količino sešteli se je potrebno v While zanki samo sprehoditi skozi zapise in v kolikor je artikel že vpisan se ustrezna vrednost prišteje...

Samo vaš makro je malce "čuden". Prvi vpis vnesete v celico A10 nato pa nadaljne vrstice dodajate tako, da najdete prazno vrstico nad vrstico 42... Kaj pa ko podatki prerastejo 42 vrstic?

No kakorkoli; sedaj je najbolj smiselno makro popraviti tako, da začnete v vrstici 10 in nato se v While zanki premikate naprej po vrsticah in v kolikor najdete artikel, popravite količino sicer nadaljujete. Ko pridete do prve prazne vrstice (torej podatkov ni več), pomeni, da artikla niste našli in ga dodate.

[tjazma]

Pozdravljeni,
Tabela (obrazec za tiskanje) se zaključi v 42 vrstici . Če mi uspe napisati proceduro z while zanko (v kar dvomimz zaradi mojega pomanjkljivega znanja ) bo 32 vrstic dovolj, ker bo enake zapise združeval .
Hvala za odgovor če mi ne rata bom spet sitnaril

[tjazma]

Pozdravljeni,
Ni teorije, da to spravim skupaj. Vas lahko prosim, da mi bolj konkretno ponazorite (napišete v obliki procedure ) vašo rešitev . Sploh ne vem kam stavek zanko while vstaviti.
Res ne bom več sitnaril

Hvala in lep pozdrav

[admin]

Glede na podatke v vašem makru je rešitev torej takšna:

Koda: Izberi vse

Option Explicit

Sub DodajArtikel()
  Dim artikel As String: artikel = Range("E6")
  Dim vrstica As Integer: vrstica = 10
  
  While (Cells(vrstica, 1) <> "")
    If (Cells(vrstica, 1) = artikel) Then
      Cells(vrstica, 2) = Cells(vrstica, 2) + Range("f6")
      Exit Sub
    End If
    
    vrstica = vrstica + 1
  Wend
  
  If (vrstica > 42) Then
    MsgBox "Artikla ne morem dodati!"
    Exit Sub
  End If
  
  Cells(vrstica, 1) = Range("E6")
  Cells(vrstica, 2) = Range("F6")
End Sub

[tjazma]

Še enkrat hvala, točno to sem želel.

[tjazma]

Pozdravljeni,
še eno podvprašanje - Kako bi dosegel, da se spremenljivka " artikel " nanaša na range ("B6 : E6") namesto
Dim artikel As String: artikel = Range("E6")
ali pa sem mimo brcnil ?
Lep pozdrav .

[admin]

B6:E6 zajema 4(!) celice in šifra artikla ne more biti v štirih celicah! Sicer pa je odgovor na vaše vprašanje:

Koda: Izberi vse

  ...
  dim artikel as Range

  artikel = Range("B6:E6")
  ...

PS: Seveda vam ob takšni spremembi zapisan makro ne bo več deloval....

[tjazma]

Pozdravljeni,
Tako sem deklariral spremenljivko tudi jaz pa sem mislil da delam narobe in res makro ni hotel delovati.
Obravnavati bi moral podatek o artiklu ki zajema 4 celice. Ali bi potemtakem moral ubrati drugačno pot ? Seveda brez vaše pomoči ne gre.
Lep pozdrav . Matjaž

[admin]

:) Odvosno kaj želite, če je postopek še vedno enak potem je tudi algoritem enak. Spremenijo pa se seveda posamezni elementi v algoritmu.

[tjazma]

Načeloma mi je postopek všeč in uporaben . Za spremembe elementov v algoritmu sem očitno prekratek . Ali pa če se vrnem k prvotnemu makroju :
If ActiveSheet.Range("a10").Value = "" Then
ActiveSheet.Range("A10:B10").Value = Sheets("LIST1").Range("E6:F6").Value
Else
ActiveSheet.Range("a42").End(xlUp).Range(Cells(10, 1), Cells(10, 2)).Value = Sheets("LIST1").Range("E6:F6").Value
End If
z PREDPOSTAVKO , da se, da po tej poti priti do v začetku opisano, željenega cilja.
Lep pozdrav - Matjaž

[admin]

Ne morem vam pomagati, ker sploh še nikoli niste opisal, kaj želite. Makro sem vam napisal in makro dela tisto, kar ste želeli. Makro je bil pisan na podlagi vašega makra in vaš makro lepo kopira vedno DVE celici E6:F6... iz česar sem sklepal, da je v prvi celici šifra artikla, v drugi pa količina...No zdaj pa ste od nekot privlekli kar območje B6 do E6....

[tjazma]

Na listu 1 imam obrazec v katerega vnašam podatke o artiklu. Podatek o artiklu je sestavljen iz štirih celic peta celica pa je količina. Ob kliku na stikalo makro skopira ta podatek (na list 2 v tabelo.

Sheets("OBRAZEC").Select
ActiveSheet.Unprotect
If ActiveSheet.Range("a10").Value = "" Then
ActiveSheet.Range("A10:F10").Value = Sheets("LIST1").Range("G6:L6").Value
Else
If ActiveSheet.Range("a44").Value = "" Then
ActiveSheet.Range("a44").End(xlUp).Range(Cells(2, 1), Cells(2, 6)).Value = Sheets("LIST1").Range("G6:L6").Value
Else
If ActiveSheet.Range("a63").Value = "" Then
ActiveSheet.Range("A63:F63").Value = Sheets("LIST1").Range("G6:L6").Value
Else
ActiveSheet.Range("A96").End(xlUp).Range(Cells(2, 1), Cells(2, 6)).Value = Sheets("LIST1").Range("G6:L6").Value
End If
End If
End If
"Makro izbere list "Obrazec " in preveri če je Celica A10 prazna. če je prazna potem kopira podatke iz "Lista 1 ("G6:L6") na List "Obrazec ("a10:f10") , če pa ni prazen napiše podatek v naslednjo vrstico spodaj. In tako vse do vrstice 44. Ko napolne 44 vrstico nadaljuje z dodajanjem podatkov v vrstici 63. Tu pa nastane moj problem . želel bi namreč,da če makro gotovi da je nek artikel že obstaja ga avtomatično sešteje če ne obstaja pa ga napiše v naslednjo prazno vrstico.

Makro katerega ste mi napisali dela to kar želim . S tem,da on obravnava eno celico,moja ideja pa je bila,da bi bravnaval več celic. Ko sem predstavil problem sem ga poenostavil,ker sem bil prepričan,da bom sposoben sam speljati zadevo do konca pa ne gre.
Lep pozdrav - Matjaž

[admin]

Glede na zapisano morate pač spremeniti test v pogoju in namesto ENE celice pač primerjati ŠTIRI celice oz. makro,ki sem vam ga napisal popraviti takole:

Koda: Izberi vse

Option Explicit

Sub DodajArtikel()
  Dim vrstica As Integer: vrstica = 10
  
  While (Cells(vrstica, 1) <> "")
    If (Cells(vrstica, 1) = Range("B6")) and (Cells(vrstica, 2) = Range("C6")) and (Cells(vrstica, 3) = Range("D6")) and (Cells(vrstica, 4) = Range("E6")) andThen
      Cells(vrstica, 5) = Cells(vrstica, 5) + Range("F6")
      Exit Sub
    End If
    
    vrstica = vrstica + 1
  Wend
  
  If (vrstica > 42) Then
    MsgBox "Artikla ne morem dodati!"
    Exit Sub
  End If
  
  Cells(vrstica, 1) = Range("B6")
  Cells(vrstica, 2) = Range("C6")
  Cells(vrstica, 3) = Range("D6")
  Cells(vrstica, 4) = Range("E6")
  Cells(vrstica, 5) = Range("F6")
End Sub

[tjazma]

Pozdravljeni,
Zahvaljujem se za potrpežljivost. Makro počne točno to kar sem želel.
Hvala še enkrat.
Lep pozdrav - Matjaž