Stránka 1 z 2
Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 11:13
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 11:20
od mike007
Úplně nejlepší bude když sem vložíš excelový sešit s daty, aby jsme mohli udělat makro na míru.
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 11:36
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 15:15
od 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.
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 18:37
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 19:04
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 19:35
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 20:57
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 17 kvě 2010 21:07
od kluluk
dobra tak identifikace neni spravny nazev, rikejme identifikaci tedy upresneni. Me jde ale o to jak si ohlidat kombinaci tri sloupcu.
dekuji
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 18 kvě 2010 09:11
od 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
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 18 kvě 2010 09:32
od navstevnik
A je to jiz opravdu definitivni? Pokud ano, tak ti to upravim.
Re: Excel: potřebuji makro pro porovnání dat
Napsal: 18 kvě 2010 09:51
od kluluk
Ano tentokrat uz je to definitivni.
Dekuji