Excel táblázat összefésülés komolyabban
2010-03-06T15:47:49+01:00
2012-03-12T08:39:00+01:00
2022-07-05T13:20:26+02:00
  • 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!
  • [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!
  • 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!
  • 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!
  • 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!
  • 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!
  • 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!

  • 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!
abcd