Excel: potřebuji makro pro porovnání dat Vyřešeno

[kluluk]

Ahoj prosim o pomoc, mam problem s VBA v Excelu. Potrebuji porovnat data z jednoho listu s daty v druhem listu.
Napr. mam v prnim listu tablku kde jsou nazev, vyrobce a kusy a v druhem listu to same, akorat ze kdyz ve druhem listu bude neco identickeho nazvu, tak potrebuji odecist kusy z druheho listu od kusu z prvniho listu a mam velky problem toto zapsat pres VBA, predem dekuji za rady.
kluluk

// Změna názvu tématu. Původní název "VBA Excel" svou nulovou informační hodnotou porušoval pravidla tohoto fóra
// mike007

[Reklama]

[mike007]

Úplně nejlepší bude když sem vložíš excelový sešit s daty, aby jsme mohli udělat makro na míru.

[kluluk]

Tady vkladam excelovy soubor, proste potrebuji hlidat kdyz to co jsem napsal v druhem listu bude odpovidat necemu co je v prvnim listu, tak aby se odecetly kusy. kusy z prvniho listu - kusy z druheho listu.
diky moc

[navstevnik]

V priloze je mozne reseni, zapsanim hodnoty Kusu v polozce na listu2 je volana udalostni procedura, ktera vyhleda na listu1 odpovidajici polozku. Pokud je na listu1 duplicitni vyskyt polozky Nazev/Vyrobce, pak je pocet z odpovidajici polozky na listu2 odecten od prvniho vyskytu. Dale je nutna shoda nazvu a vyrobce na obou listech.

[kluluk]

Mnohokrat dekuji. :-)
Vypada to vyborne, jen bych chtel jeste poprosit, zda by bylo mozne trochu mi objasnit kod? Abych to dokazal pripadne i modifikovat o dalsi sloupce a nebo podminku, abych nepretekl do zapornych cisel.
dekuji
kluluk

[navstevnik]

komentovana procedura:

Kód: Vybrat vše

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'deklarace promennych
  Dim Cll As Range, SBlk As Range, OK As Boolean
  ' omezeni rozsahu promenne target na jednu bunku pri nazani bloku bunek
  Set Target = Target.Resize(1, 1)
  ' test, zda Target je ze sloupce C:C
  If Not Intersect(Target, Me.Range("c:c")) Is Nothing Then
    ' nastavi promennou OK na hodnotu False
    OK = False
    ' nastavit blok bunek na listu1
    With Worksheets("list1")
      Set SBlk = Intersect(.UsedRange, .Range("a:a"))
    End With
    ' prohledat sloupec A:A na listu1, hledat hodnotu z list2!Axx - nazev
    With SBlk
      Set Cll = .Find(Target.Offset(0, -2).Value, LookIn:=xlValues, LookAt:=xlWhole)
      If Not Cll Is Nothing Then
        ' nalezeno ve sloupci A:A, overit zda se shoduje i Vyrobek
        If Cll.Offset(0, 1).Value = Target.Offset(0, -1).Value Then
          ' snizit hodnotu kusu na listu1, kdyz bude vysledek >=0
          If Cll.Offset(0, 2).Value - Target.Value >= 0 Then
            Cll.Offset(0, 2).Value = Cll.Offset(0, 2).Value - Target.Value
          Else
            MsgBox "Vysledny stav je <0"
            ' vynulovat vlozenou hodnotu, potlacit prepocet a volani procedur
            Application.EnableEvents = False
            Target.Value = 0
            Application.EnableEvents = True
          End If
          OK = True
        End If
      End If
    End With
    Set Cll = Nothing
    Set SBlk = Nothing
    If Not OK Then MsgBox "Nenalezeno...blabla"
  End If
End Sub

[kluluk]

Parada diky moc akorat, bych jeste chtel poprosit, o pomoc kdybych si ted chtel pridat uplne na zacatek do sloupce A sloupec s nazvem identifikace. Aby to fungovalo i pro tento treti sloupec. To znamena ze to bude porovnavat identifikaci, nazev a vyrobce a kdyz budou stejne, tak to prepocita ty kusy.
Ja bohuzel jeste nepochopil ten kod na tolik abych si to dokazal uspesne modifikovat, nejak se tu s tim peru. Diky moc
kluluk

[navstevnik]

Identifikace - ma vyznam, pokud to je jedinecny udaj, pak postaci vyhledavat pouze podle identifikace. V tomto smyslu je upravena udalostni procedura listu 2:

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
' udalostni procedura snizi stav ks v prislusnem zaznamu na list1
' deklarace promennych
  Dim Cll As Range, SBlk As Range, OK As Boolean
  ' omezeni rozsahu promenne target na jednu bunku pri mazani bloku bunek
  Set Target = Target.Resize(1, 1)
  ' test, zda Target je ze sloupce D:D
  If Not Intersect(Target, Me.Range("d:d")) Is Nothing Then
    ' nastavi promennou OK na hodnotu False
    OK = False
    ' nastavit blok bunek na listu1
    With Worksheets("list1")
      Set SBlk = Intersect(.UsedRange, .Range("a:a"))
    End With
    ' prohledat sloupec A:A na listu1, hledat hodnotu z list2!Axx - identifikace
    With SBlk
      Set Cll = .Find(Target.Offset(0, -3).Value, LookIn:=xlValues, LookAt:=xlWhole)
      If Not Cll Is Nothing Then
        ' snizit hodnotu kusu na listu1, kdyz bude vysledek >=0
        If Cll.Offset(0, 3).Value - Target.Value >= 0 Then
          Cll.Offset(0, 3).Value = Cll.Offset(0, 3).Value - Target.Value
        Else
          MsgBox "Vysledny stav je < 0, blabla..."
          ' odstranit vlozenou hodnotu kusu na listu2, potlacit prepocet a volani procedury
          Application.EnableEvents = False
          Target.Value = vbNullString
          Application.EnableEvents = True
        End If
        OK = True
      End If
    End With
    Set Cll = Nothing
    Set SBlk = Nothing
    If Not OK Then MsgBox "Nenalezeno...blabla"
  End If
End Sub

[kluluk]

dobra tak identifikace neni spravny nazev, rikejme identifikaci tedy upresneni. Me jde ale o to jak si ohlidat kombinaci tri sloupcu.
dekuji

[kluluk]

Omlouvam se, ze to takhle komplikuji, ale v konecne fazi jsem dosel k tomu, ze potrebuju 4 sloupce: Nazev, Upresneni, Vyrobce, Kusu.
Jestli je neco duplicitni, se musi porovnavat v ramci 3 sloupcu (Nazev, Upresneni, Vyrobce).
Predchozi kod pro porovnavani 2 sloupcu byl skvely, ale ja ho nejak nedokazu upravit na 3 sloupce.
Pomuze mi prosim nekdo?

Dekuji kluluk

[navstevnik]

A je to jiz opravdu definitivni? Pokud ano, tak ti to upravim.

[kluluk]

Ano tentokrat uz je to definitivni.
Dekuji