Párovaní
Napsal: 11 led 2017 11:56
Zdrvím všechny VBA profíky. Poraďte prosím, nějak jsem se zacyklil a nedaří se mne to vyřešit.
Mám skupiny drahých součástek, které se skládají vždy ze dvou částí. (rotor a stator, každý má svoje číslo). Při práci se podaří poškodit některý z těchto dílu, jakkoliv je nutno vést seznam těchto poškozených dílů, kde výsledkem je např. 20 rotorů, 15 statorů s různými čísly. Abych je mohl vyřadit, musím je spárovat tak, jak mají být. Tj. rotor “a“ se statorem „a“, „b“ s „b“, atd. Jenom že to je šílená práce s čísly, přehazování… než se podaří zjistit výsledek.
Vyřešit se to dá makrem, o co se snažím, ale jsem se zasekl. Co řeším: Ve sloupci „A“ mám seznam všech poškozených dílů (mix rotory, statory různých čísel). Ve sloupci „C“ doplněnou informaci pomoci VlookUP jaký má být protikus.
Co potřebuji vyřešit: V řádku 5, sloup. A mám součástku (nějaké číslo), ale vím, že v tom samém sloupci někde od řádku 6 až xx mám i protikus. Tedy potřebuji, aby podle informace ze sloupce C, ř.5, kde je info jaký má být protikus tento našel v seznamu ve sloupci A, vyjmul to číslo z buňky a přiřadil do řádku č. 5, do sloupce B. Tím pádem získám kompletní set. Pak další řádek (6) tj. hledám protikus k tomuto dílu ve sl. A (jaké číslo to má být zjistím ve sl. C, ř.6) ,hledám od ř.7 až xx, když najde vyjme, přiřadí do B, ř.6 atd. až do doby, než se mě spárují do dvojíc všechny možné součástky. Výsledkem má být určitý počet dvojíc a pak několik čísel ve sl. A, které k sobe protikus nemají. Problém, který mně vzniknul je, že cyklus funguje do doby, když nenajde protikus. Pokud protikus v řádcích pod nim není, kód se zastaví. Potřebuji doplnit do kódu IF, ale nevím jak to napsat (když nenajde, tak aby ten řádek ve sloupci A poté přeskočil, případně to číslo jinak zabarvil) a pokračoval v párovaní dál následujícím řádkem. Tj. hledám protikus v číslech pod, který porovnám v C ve stejného řádku…..
Kód v příloze. Děkuji.
Sub Parovat()
Dim pn As Range
Dim a
Dim x
x = 5
Dim i As Long
Dim radek As Long
a = Cells(x, 3)
For i = 1 To 1000
Application.ScreenUpdating = False
Range("A:A").Select
Set pn = Selection.Find(What:=a)
If Not pn Is Nothing Then ´tohle IF řeší případ, že v řádku 5, sl. C nebylo číslo protikusu, tak přeskočí na další pod ním a řádek 5 neřeší vůbec
pn.Select
End If
Selection.Cut
Cells(x, 2).Select
ActiveSheet.Paste
x = x + 1
Next
End Sub
Mám skupiny drahých součástek, které se skládají vždy ze dvou částí. (rotor a stator, každý má svoje číslo). Při práci se podaří poškodit některý z těchto dílu, jakkoliv je nutno vést seznam těchto poškozených dílů, kde výsledkem je např. 20 rotorů, 15 statorů s různými čísly. Abych je mohl vyřadit, musím je spárovat tak, jak mají být. Tj. rotor “a“ se statorem „a“, „b“ s „b“, atd. Jenom že to je šílená práce s čísly, přehazování… než se podaří zjistit výsledek.
Vyřešit se to dá makrem, o co se snažím, ale jsem se zasekl. Co řeším: Ve sloupci „A“ mám seznam všech poškozených dílů (mix rotory, statory různých čísel). Ve sloupci „C“ doplněnou informaci pomoci VlookUP jaký má být protikus.
Co potřebuji vyřešit: V řádku 5, sloup. A mám součástku (nějaké číslo), ale vím, že v tom samém sloupci někde od řádku 6 až xx mám i protikus. Tedy potřebuji, aby podle informace ze sloupce C, ř.5, kde je info jaký má být protikus tento našel v seznamu ve sloupci A, vyjmul to číslo z buňky a přiřadil do řádku č. 5, do sloupce B. Tím pádem získám kompletní set. Pak další řádek (6) tj. hledám protikus k tomuto dílu ve sl. A (jaké číslo to má být zjistím ve sl. C, ř.6) ,hledám od ř.7 až xx, když najde vyjme, přiřadí do B, ř.6 atd. až do doby, než se mě spárují do dvojíc všechny možné součástky. Výsledkem má být určitý počet dvojíc a pak několik čísel ve sl. A, které k sobe protikus nemají. Problém, který mně vzniknul je, že cyklus funguje do doby, když nenajde protikus. Pokud protikus v řádcích pod nim není, kód se zastaví. Potřebuji doplnit do kódu IF, ale nevím jak to napsat (když nenajde, tak aby ten řádek ve sloupci A poté přeskočil, případně to číslo jinak zabarvil) a pokračoval v párovaní dál následujícím řádkem. Tj. hledám protikus v číslech pod, který porovnám v C ve stejného řádku…..
Kód v příloze. Děkuji.
Sub Parovat()
Dim pn As Range
Dim a
Dim x
x = 5
Dim i As Long
Dim radek As Long
a = Cells(x, 3)
For i = 1 To 1000
Application.ScreenUpdating = False
Range("A:A").Select
Set pn = Selection.Find(What:=a)
If Not pn Is Nothing Then ´tohle IF řeší případ, že v řádku 5, sl. C nebylo číslo protikusu, tak přeskočí na další pod ním a řádek 5 neřeší vůbec
pn.Select
End If
Selection.Cut
Cells(x, 2).Select
ActiveSheet.Paste
x = x + 1
Next
End Sub