Párovaní

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Luffi
nováček
Příspěvky: 7
Registrován: listopad 16
Pohlaví: Muž
Stav:
Offline

Párovaní

Příspěvekod Luffi » 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

Reklama
guest
Pohlaví: Nespecifikováno

Re: Párovaní

Příspěvekod guest » 11 led 2017 17:07

Příloha do prkýnka...

Luffi
nováček
Příspěvky: 7
Registrován: listopad 16
Pohlaví: Muž
Stav:
Offline

Re: Párovaní

Příspěvekod Luffi » 12 led 2017 09:34

Sorry, to nejdůležitejší jsem zapoměl. Děkuji předem za radu.
Přílohy
vysledek.xlsm
(23.13 KiB) Staženo 13 x
priklad.xlsm
(22.57 KiB) Staženo 11 x


Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti