2010-03-06T15:47:49+01:00
2012-03-12T08:39:00+01:00
2022-07-24T05:02:48+02:00
- halivudválasza Charon (15:47) részére
- 2012.03.12. 08:39
- permalink
Nem írtad mennyi euro-t szánsz a megvalósításra... ebben a rovatban.
Ha meg máshová akartad, nem írtad meddig jutottál magadtól.Mutasd a teljes hozzászólást!- *deleted_29487814hozzászólása
- 2012.03.11. 21:28
- permalink
[OFF]
Mindig rángó görcsöt kapok, amikor magukat "komoly"-nak nevező cégek Excelben tartanak "adatbázisokat".
Itt az idő, a feladatra írni kell egy igazi programot (igazi adatbázissal, igazi reference/constraint figyeléssel).
Tudom ilyet lehet Excelben is alkotni, de akkor meg már minek arra időt pocsékolni
Ha már az "Állás/munka" rovatban jelent meg...
Mutasd a teljes hozzászólást!- Sziasztok!
Szeretnék segítséget kérni.
Van két excel táblám, amit szeretnék összefésülni.
A munka1 táblában van 2000 sor, a munka2 táblában 3000, amiből kb 1500 mind a két táblában megvan. hogyan tudnám a két táblát egy harmadikba (munka3) összefésülni úgy, hogy ami megegyezik azt cak egyzer tegye bele.
Esetleg ha az összefésülés után mér kerűlne új adat valamelyik táblába, akkor hogyan tudnám a munka3-ba betenni a legelső üress sorba?
????Mutasd a teljes hozzászólást! - Micuválasza Charon (23:44) részére
- 2010.03.08. 06:10
- permalink
Ne csodálkozz, hogy addig tart.
For i = 1 To 65536
6000-es ciklus
For i = 1 To 65536
If Range(celnev & i).Value <> "" Then
j = 1
Do While (Not (j > maxelem))
Egy 655536-os ciklus, amibe 2000-szer beágyazva egy (átlag) 3000-es (mivel van amikor 1, van amikor 6000 lépés kell) ciklus
---
Az összehasonlítás dologra esetleg van ötleted
Karóra?
Szerintem észrevehető különbség van ks11111 megoldásához képest.
Komolyan:
Az elején
kezd=now() ' vagy time()
A végén
veg=now() ' vagy time()
és kivonod a 2-t.
---
hogyan lehetne teljes sorokat hozzáfűzni az alaptáblázat aljához
a "maxelem" változó megmondja, hol a lista vége. A maxelem+1 sorba beírhatsz valamit. (ne felejtsd el a maxelem értékét ténylegesen növelni)
Mutasd a teljes hozzászólást!- Charonválasza Micu (08:01) részére
- 2010.03.07. 23:44
- permalink
Köszönöm a te kódjaidat is! Mindenféleképen tesztelem majd őket, csak a mai nap sajnos nem tudtam rá időt szakítani.
Gondoltam rá, hogy összehasonlításképpen csinálok majd egy sebességtesztet, lemérem melyik kód végez hamarabb.
Abban igazad van, hogy a nagyobb táblázatokkal eljátszadozik a gépem. Egy 6000 soros táblázatba fésültem bele kezdetnek egy 2000 sorost és kb. 40 percig tartott mire befejezte. Pedig egy viszonylag erős intel q6600-as van a képembe, bár ebben az esetben a 4 magja, gondolom semmit se számít.
Az összehasonlítás dologra esetleg van ötleted, hogyan lehetne teljes sorokat hozzáfűzni az alaptáblázat aljához?Mutasd a teljes hozzászólást!- Micuválasza Micu (07:29) részére
- 2010.03.07. 08:01
- permalink
hely=application.match(Range(fornev & j).Value, range(celnev & i),0)
helyett
hely=application.match(Range(fornev & j).Value, range(celnev),0)
Mutasd a teljes hozzászólást!- Micuválasza ks11111 (20:42) részére
- 2010.03.07. 07:29
- permalink
Azért néhány változtatás, hogy sebessége is legyen, és "kissé" rövidebb is legyen:
For i = 1 To 65536
If Range(fornev & i).Value <> "" Then maxelem = i
Next i
helyett:
maxelem=range(formev & 1).end(xldown).row
(Bár esetleg usedrange használata célszerűbb)
---
For i = 1 To 65536
If Range(celnev & i).Value <> "" Then
helyett is elgondolkodnék ezen, bár itt nem annyira jelentős.
-----------
Do While (Not (j > maxelem))
If (Range(celnev & i).Value = Range(fornev & j).Value) Then
Range(celar & i).Value = Range(forar & j).Value
Exit Do
End If
j = j + 1
Loop
If j > maxelem Then
Range(celnev & i).Interior.Color = RGB(255, 0, 0)
Else
Range(celnev & i).Interior.Color = RGB(0, 255, 0)
End If
Spóroljunk már a ciklusban cikluson....
Ha már Excel, akkor:
celnev="Munka1!A:A" hely=application.match(Range(fornev & j).Value, range(celnev & i),0) if vartype(hely)<>vberror then Range(celar & i).Value = Range(forar & hely).Value Range(celnev & i).Interior.Color = RGB(0, 255, 0) else Range(celnev & i).Interior.Color = RGB(255, 0, 0) end if
----
Egyberakva "alig" gyorsabb, rövidebben és Excelesebben:
Sub uj() celnev = "Munka1!A" celar = "Munka1!B" fornev = "Munka2!A:A" forar = "Munka2!B" maxelem = Range(celnev & 1).End(xlDown).Row ' maxadat = Range(fornev).End(xlDown).Row For i = 1 To maxelem hely = Application.Match(Range(celnev & i), Range(fornev), 0) ' itt jobb változó választással lehetne a range(fornev) helyett optimálisabb, hogy csak maxadat-ig keressen If VarType(hely) <> vbError Then Range(celar & i).Value = Range(forar & hely).Value Range(celnev & i).Interior.Color = RGB(0, 255, 0) Else Range(celnev & i).Interior.Color = RGB(255, 0, 0) End If Next End Sub
Ha a szinezésnél jó lenne a feltételes formázás (bár ez a lista méretétől függ, hogy érdemes-e használni), akkor még ciklus se kell hozzá:
Sub uj2() Set celarlap = Sheets("munka1") forar = "Munka2!" celnev = "Munka1!A" fornev = "Munka2!A1" maxelem = Range(celnev & 1).End(xlDown).Row maxadat = Range(fornev).End(xlDown).Row celarlap.Range("B1:B" & maxelem).FormulaR1C1 = "=vlookup(RC[-1]," & forar & "R1C1:R" & maxadat & "C2,2,0)" On Error Resume Next celarlap.Range("B1:B" & maxelem).SpecialCells(xlCellTypeFormulas, 16).ClearContents On Error GoTo 0 celarlap.Range("B1:B" & maxelem).Copy celarlap.Range("B1:B" & maxelem).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False With celarlap.Range("A1:A" & maxelem) .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:="=C1=""""" .FormatConditions(1).Interior.ColorIndex = 3 .FormatConditions.Add Type:=xlExpression, Formula1:="=C1<>""""" .FormatConditions(2).Interior.ColorIndex = 4 End With End Sub
Feldolgozási sebességben a leggyorsabb, de a szinezés nagy lista esetén nem célszerű.Mutasd a teljes hozzászólást!- Charonválasza ks11111 (20:42) részére
- 2010.03.07. 02:40
- permalink
Ezer köszönet!
Pont erre gondoltam, ez igen!Nagyon hálás vagyok ezért a remekműért! Rendesen elsőre minden kecmec nélkül megcsinálta, amit kell. Kipróbáltam, a nagy táblázatba belefésültem két kisebbet minden simán ment elsőre. Nagyon jó a színezés is, mert a művelet után a szűrőkkel a színekre keresve nagyon könnyem meg lehet találni azokat a termékeket amikkel még kell dolgozni.
Arra is gondoltam, hogy összehasonlító táblázatokat is csinálnék vele, hogy mondjuk 2009-hez képest mennyit drágultak 2010-ben a termékek. Ki is próbáltam ezt is rögtön "a forar=forintos ár oszlopa" ezt "C" oszlopra raktam és szépen mellé is rakta a régi áraknak az újakat.
Arra esetleg van lehetőség, hogy ha mondjuk, a 2010-es táblázat tartalmaz új termékeket a 2009-es képest, azoknak a teljes sorait beszúrja a program az alaptáblázat2009-es utolsó sora után a táblázat aljára? Meg akár kiemelje ezeknek a termékkódjait mondjuk kék színnel?
Nagyra becsülöm az eddigi fáradozásaidat, nem is tudom mihez kezdetem volna a munkahelyem, ha nincs ez a kis makró. Ha nem nagy nehézség légy szíves egészítsd ki a kódot, szerintem mások is biztosan nagy hasznát veszik az itt leírtaknak majd a jövőben.
Mutasd a teljes hozzászólást!- ks11111válasza Charon (15:47) részére
- 2010.03.06. 20:42
- permalink
Hello,
ez a kis kód kb azt csinálja amit leírtál. másold egy munkalapra az euros táblát, egy másikra a forintos táblát
állítsd be az elérést:
a celnev=termeknév oszlopa
a celar=euros ár oszlopa
a fornev=termeknév oszlopa
a forar=forintos ár oszlopa
ha megtalálja zöld lesz az euros név és kicseréli az árat forintra, ha nem akkor piros lesz és euros marad.
üdv...
Sub Osszefesul() Dim celnev, celar, fornev, forar As String Dim i, j, maxelem As Long celnev = "Munka1!A" celar = "Munka1!B" fornev = "Munka2!A" forar = "Munka2!B" maxelem = 1 For i = 1 To 65536 If Range(fornev & i).Value <> "" Then maxelem = i Next i For i = 1 To 65536 If Range(celnev & i).Value <> "" Then j = 1 Do While (Not (j > maxelem)) If (Range(celnev & i).Value = Range(fornev & j).Value) Then Range(celar & i).Value = Range(forar & j).Value Exit Do End If j = j + 1 Loop If j > maxelem Then Range(celnev & i).Interior.Color = RGB(255, 0, 0) Else Range(celnev & i).Interior.Color = RGB(0, 255, 0) End If End If Next i End Sub
Mutasd a teljes hozzászólást!- Sziasztok!
A feladat az lenne, hogy adott egy excel táblázat kb. 6000 soros, amibe a legújabb termékek és a hozzájuk tartózó eurós árak találhatóak. Ebbe a táblázatba kellene belefésülni több kisebb kb. 2000 soros táblázatot, amelyekben már a megkalkulált forintos árak vannak. A koncepció az lenne, hogy a termékkódok egy része megegyezik a táblázatokban és az eurós árakat ez alapján felül kellene írni a forintos árakkal. A táblázat nagysága miatt már manuálisan nem lehet megcsinálni, ezért kellene rá egy makró. A feladatot nehezíti, hogy vannak üres sorok a táblázatokban illetve a termékkódok és az árak különböző oszlopokban helyezkednek el, tehát a táblázatok és a cellaformátumok nem egyeznek. A lényeg, hogy a keresési paraméterek megadása alapján (melyik oszlopban helyezkednek el a régi és új árak illetve a kódszámok)össze kellene hasonlítani a termékkódok karaktersorait egy kereséssel és ha egyezést talál írja felül az árat. Persze egy-egy termék adatai mindig egy sorban helyezkednek el.
Az egyszerűség kedvéért, hogy egy fájlban keljen dolgozni, szerintem érdemes különböző munkalapokra másolni a táblázatokat.
Az is jó dolog lenne, ha pirossal kiemelné a sorokat, amiket nem talált meg, vagy zölddel amit megtalált, hogy később egy képlettel a maradék árral amit nem talált meg egyszerűbb legyen dolgozni.
Sok helyen nézegettem, de nem igazán találtam erre megfelelő képletet. Mondjuk ez elég hasonló link de nállam valamiért nem csinál semmit excel 2007-be 2003-ba meg runtime error-t ír. Kérlek segítsetek, mert a főnökömnek fontos lenne és tőlem várja a megoldást.Válaszaitokat előre is köszönöm! Mutasd a teljes hozzászólást!