Stránka 1 z 2
Excel- makro na vyhledání a přesunutí
Napsal: 07 čer 2010 18:54
od Hawkey
Zdravím,
potřeboval bych poradit s makrem. Mám tabulku na import do eshopu, kde jsou čísla artiklů atd. Ale jeden výrobek, má například několik barev a velikostí, ale i ty jsou označeny vlastním číslem:( potřebuju makro, které když najde ve sloupci A řádky, které mají podobná čísla, lišící se pouze poslední cifrou (např. 19543734,19543736 a 19543739). Pak aby první jemu podobné vzal hodnotu z CA a z CB a vložil do CP toho předka, pokud bude další s podobným číslem lišící se tou poslední cifrou tak aby opět vzal CA a CB a vložil do toho prvního ale ne do CP ale do následující tzn. CS atd... Ty obsahy buněk CA a CB by měli být zřetězeny že mezi nimi bude středník. a vždy když najde takto podobného a převede ty dvě data do nového sloupce původního (předka) tak aby smazal obsah buňky A aktuálního.
Doufám, že to není moc komplikovaně napsané. Pokud to bude nutné, klidně sem hodím soubor s čím to je potřeba pracovat
Předem moc děkuji za jakékoli rady
Re: Excel- makro na vyhledání a přesunutí
Napsal: 07 čer 2010 22:42
od navstevnik
Cetl jsem vic nez jednou, ale vychazi mi pouze, ze neco se ma nekam presunout a pak neco smazat.
Pripojit prilohu s testovacimi daty, tedy stavem pred presunem a na dalsim listu (muze i na tomtez) rucne vytvorenym vysledkem a s popisem co a jak vztahujicim se ke konkretnim bunkam, protoze "podobne cislo, predek,..." je prilis obecne urceni, bylo potreba hned a ne az na vyzvani.
Re: Excel- makro na vyhledání a přesunutí
Napsal: 08 čer 2010 23:14
od navstevnik
Nize je uvedena procedura (v editoru VBA - Alt+F11 - vlozit do standardniho modulu, pripadne upravit nazvy listu, volat z nabidky Nastroje>Makro>Makra - Alt+F8 - nebo klavesovou zkratkou), snad se mi to z popisu pozadavku podarilo splnit, vysledek je na listu 2:
Kód: Vybrat vše
Option Explicit
Sub FindTranspose()
Dim SBlk As Range, SCll As Range, SCllVal As Long, SCllLeft As String
Dim TBlk1 As Range, TBlk2 As Range, TBlk3 As Range, TCll As Range, TOfsR As Long, TOfsC As Integer
' cilove bloky
With Worksheets("sheet2")
Set TBlk1 = .Range("a1:be1")
Set TBlk2 = .Range("cy1")
Set TBlk3 = .Range("dc1")
Set TCll = .Range("dd1")
End With
TOfsR = -1
With Worksheets("sheet1")
Set SBlk = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row) ' zdoj blok
End With
' list 1 setridit podle sloupce A:A
Worksheets("sheet1").Select
SBlk.Resize(SBlk.Rows.Count, 107).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' prohledavat SBlk
SCllLeft = vbNullString
For Each SCll In SBlk.Cells
' cislo ve sl A:A bez posledni cislice - skupina
If Left(CStr(SCll.Value), Len(CStr(SCll.Value)) - 1) <> SCllLeft Then
' nova skupina
SCllLeft = Left(CStr(SCll.Value), Len(CStr(SCll.Value)) - 1)
TOfsR = TOfsR + 1 ' ofset radku na cilovem listu
' prenest bloky
TBlk1.Offset(TOfsR, 0).Value = SCll.Resize(1, 57).Value ' AAx:BEx
TBlk2.Offset(TOfsR, 0).Value = SCll.Offset(0, 102).Value ' CYx
TBlk3.Offset(TOfsR, 0).Value = SCll.Offset(0, 106).Value ' DCx
' prenest AAx;BEx;CVx -> DDx
TCll.Offset(TOfsR, 0).Value = SCll.Value & ";" & SCll.Offset(0, 56).Value & ";" & SCll.Offset(0, 99).Value
TOfsC = 1
Else
' prvek ze skupiny
' prenest AAy;BEy;CVy -> DEx (DFx,...)
TCll.Offset(TOfsR, TOfsC).Value = SCll.Value & ";" & SCll.Offset(0, 56).Value & ";" & SCll.Offset(0, 99).Value
TOfsC = TOfsC + 1 ' ofset sloupcu
End If
Next SCll
With Worksheets("sheet2")
.Range(.UsedRange.Address).Columns.AutoFit ' upravit sirku sloupcu
End With
Set SBlk = Nothing
Set SCll = Nothing
Set TBlk1 = Nothing
Set TBlk2 = Nothing
Set TBlk3 = Nothing
Set TCll = Nothing
End SubProtoze testovaci data obsahuji pouze vyrobky jedne skupiny 2642102Y, otestuj na vetsim poctu skupin
Re: Excel- makro na vyhledání a přesunutí
Napsal: 08 čer 2010 23:28
od Hawkey
Mockrát děkuju, jdu to zkusit. přikládám jinou přílohu, která doufám bude více jasná a hlavně bude více pochopitelná. Hned to zkusím a každopádně hrozně moc děkuji!
Re: Excel- makro na vyhledání a přesunutí
Napsal: 08 čer 2010 23:45
od Hawkey
super! Funguje to! Sice to je tak že to bere ty čísla artiklů a až teď jsem si uvědomil, že záleží na shodnosti těch popisů, ale to vůbec nevadí, takhle je to super. Mockrát děkuju.
Re: Excel- makro na vyhledání a přesunutí
Napsal: 09 čer 2010 00:04
od navstevnik
Mam tomu rozumet tak, ze i kdyz procedura odpovida ukazce, kterou jsi odstranil, je to OK? Ta nova ukazka by totiz vyzadovala napsat uplne jinou proceduru.
Re: Excel- makro na vyhledání a přesunutí
Napsal: 09 čer 2010 07:35
od Hawkey
No to ano. Ale je to vlastně výsledkem to samé. Tahle metoda, je rychlejší a sice můžou nastat situace kdy to nějaký výrobek nesrazí do toho jednoho, ale to nevadí to. takových situacích nastane zanedbatelne mnozstvi. Takhle to jde taky a vyhoda je rychlost oproti tomu druhemu. Jeste jednou diky moc
Re: Excel- makro na vyhledání a přesunutí
Napsal: 17 čer 2010 09:37
od Hawkey
Mohl by mi někdo ještě pomoci? Ten předešlej kód upravit tak, aby se v podmínce vytvoření té skupiny nebralo v potaz hodnota sloupce A bez poslední cifry, ale to, jestli jsou shodné hodnoty (v tomto případě texty) ve sloupci F?
Re: Excel- makro na vyhledání a přesunutí
Napsal: 17 čer 2010 13:21
od navstevnik
Jak jsem uvedl, uvedena procedura byla napsana pro ukazku, kterou jsi z dotazu odstranil. Takze pozadujes upravit tuto proceduru nebo mas na mysli napsat novou proceduru pro ukazku z 8.6.10?
Re: Excel- makro na vyhledání a přesunutí
Napsal: 21 čer 2010 12:12
od Hawkey
Vložím úplně novou ukázku jak to má být, budou asi trochu změny, ale nejdřív odzkouším jednu věc a pak bych sem hodil přímo tu ukázku... A ještě jednou moc díky za pomoc
Re: Excel- makro na vyhledání a přesunutí
Napsal: 01 črc 2010 12:53
od Hawkey
Tak už konečně vím jak to musí být. Mělo by to fungovat stejně jako je makro výše napsané, ale porovnávat by se nemělo podle buněk s číslem artiklu A ale podle toho zda jsou shodné popisy, to znamená buňky ve sloupci F, a podle shodnosti tvořit ty skupiny. A další změna je v tom, že kromě přesunu těch hodnot ze sloupce A by se měli zkopírovat také za text ve sloupci E a oddělit čárkou.
Re: Excel- makro na vyhledání a přesunutí
Napsal: 01 črc 2010 13:08
od navstevnik
Predmetna procedura byla napsana pro v mezicase odstraneny soubor ukazka.xlsx. V ukazce z 8.6. jsou vsak zaznamy slucovany do jinych sloupcu.
Takze se jednoznacne rozhodni, co potrebujes: upravit proceduru pro puvodni ukazku nebo napsat novou proceduru pro novou ukazku.