[csozsi]

Idézet: Delila - Dátum: 2012. 09. 17. 14:41

Az eredeti felvetésben nem tudom, mi a 710-es és 720-as kezdet.

Köszi a segítséget, majd kipróbálom. Addig is begépeltem, természetesen vétettem benne hibát.
A 710, 720 az eszköz neve, ami adott pillanatban zavaró, mert egyszerűbb azt lekezelni, hogy 2. oszlop, 1-es eszköz, nyolcadik sorának harmadik pontja, (2-1-8-3), mint keresgélni, és átszámolni a 720-0-7-2 pozíciót (mert a 720-0 nevű eszköz a 2. oszlop 1-es eszköze).
Az első oszlopomban (nem az excelben, hanem a hardveren) ettől még nagy valószínűséggel 310-0, 310-1, 310-2, majd 311-0, 311-1, 311-2 eszközeim nulladik sorának nulladik pontjával kezdődik (310-0-0-0, 310-1-0-0... 311-0-0-0, 311-1-0-0)

310-0-0-0, 310-0-0-1... stb  720-0-0-0, 720-0-0-1... stb
310-0-1-0, 310-0-1-1         720-0-1-0, 720-0-1-1
310-0-2-0, 310-0-2-1         720-0-2-0, 720-0-2-1
.                            .
.                            .
.                            .
stb                          stb


310-1-0-0, 310-1-0-1... stb  720-1-0-0, 720-0-0-1... stb
310-1-1-0, 310-1-1-1         720-1-1-0, 720-0-1-1
310-1-2-0, 310-1-2-1         720-1-2-0, 720-0-2-1
.                            .
.                            .
.                            .
stb                          stb

[Delila]

csozsi

Ebből:
310-0-0-0, 310-0-0-1, 310-1-0-0, 310-1-0-1
310-0-1-0, 310-0-1-1, 310-1-1-0, 310-1-1-1
310-0-2-0, 310-0-2-1, 310-1-2-0, 310-1-2-1

ez lesz a makró hatására
310-1-1-1, 310-1-1-2, 310-2-1-1, 310-2-1-2
310-1-2-1, 310-1-2-2, 310-2-2-1, 310-2-2-2
310-1-3-1, 310-1-3-2, 310-2-3-1, 310-2-3-2

Kis módosítással a makró:

Sub Pozicio()
    Dim usor%, oszlop%, uoszlop%
    usor% = Sheets("Munka1").UsedRange.Rows.Count
    uoszlop% = Sheets("Munka1").UsedRange.Columns.Count
    
    For oszlop% = 1 To uoszlop%
        Sheets("Munka3").Range("A:E") = ""  'előző adatok törlése
        Sheets("Munka1").Select
        
        'Az oszlop%-adik oszlop másolása a Munka3 A oszlopába
        Columns(oszlop%).Copy Sheets("Munka3").Range("A1")
        Sheets("Munka3").Select
        Range("A1:A" & usor%).Select
        
        'Szövegből oszlopok a Munka3 lapon
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, Other:=True, OtherChar _
            :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
            TrailingMinusNumbers:=True
            
        'Képlet az E oszlopba
        Range("E1:E" & usor%).FormulaR1C1 = _
            "=RC[-4]&""-""& RC[-3]+1&""-""&RC[-2]+1&""-""&RC[-1]+1"
            
        'E oszlop értékeinek másolása a Munka1 aktuális oszlopába
        Range("E1:E" & usor%).Copy
        Sheets("Munka1").Select
        Cells(1, oszlop%).Select
        Selection.PasteSpecial Paste:=xlValues
    Next
End Sub

[pisti1919]

Üdv!

Egy kis segítséget szeretnék kérni. Az lenne a kérdésem hogy képlet mellé tudok e szöveget hozzárendelni. Pl: A oszlopba távolságok vannak megadva méterben, ezeket pl =A1/1000 el átváltom km-be a B oszlopba. Hogy tudnám a km-t mögé rakni? A cellaformázásnál próbáltam a szám fül alatt, de ott se tudtam megoldani.

Válaszokat előre is köszönöm!

Szerkesztette: pisti1919 2012. 09. 28. 12:28 -kor

[Delila]

pisti1919

Szia!

A cellaformazasnal az egyeni kategoriaban a megszokott formad utan ird be idezojelek kozott a km-t. Peldaul # ##0" km".

[pisti1919]

Köszönöm szépen a segíséget! Esetleg tudna valaki olyan oktatóanyagot amiből rendesen meg lehet tanulni a használatát? Lehetőleg ingyenest

[elbandita]

Tisztelt Urak az alábbi problémám adódott, mi lesz a megoldás?

Adott két adatbázis (mindegyik egy excel munkafüzet lap)(sok sor és kb. 10 oszlop). A feladat, hogy az "1" munkafüzetből az egyik oszlop alapján "B" vegyük ki azokat a sorokat amelyek "2" munkafüzetben nem szerepelnek (szintén egyik oszlop alapján). Majd ezeket a különbség sorokat másoljuk "3" munkafüzetbe egymás után sorban. Ha ez megvan akkor a "2" munkafüzetből adjuk hozzájuk azokat amelyek "D" oszlop alapján egy dátumnál kisebb értékűek.

Érthetőben: egyik adatbázisban szerepel pl.: 20 autó (típus, gyártmány, motorszám,évjárat...stb.), másik adatbázisban 15 darab autó. Egy harmadik lapon azokat kell megjeleníteni amelyek az elsőben benne vannak de a másikban nem (mondjuk motorszám alapján (B oszlop)). Majd ha ez megvan akkor tegyük be a listába a második adatbázisból azokat amelyek gyártási éve pl.: 2000 előtti.

[Delila]

elbandita

Megoldható, de ehhez pontos helyeket kell megadnod.
Első füzetből teljes sor másolása a 3. füzetbe, ha az 1. füzet B oszlopa nem található a 2. füzet ??? oszlopában.
2. füzetből teljes sor másolása a 3. füzetbe, ha az ??? oszlop évszáma kisebb, mint 2000. Hol adod meg az évszámot? A makróban?

[elbandita]

Idézet: Delila - Dátum: 2012. 10. 18. 19:15

elbandita

Megoldható, de ehhez pontos helyeket kell megadnod.
Első füzetből teljes sor másolása a 3. füzetbe, ha az 1. füzet B oszlopa nem található a 2. füzet ??? oszlopában.
2. füzetből teljes sor másolása a 3. füzetbe, ha az ??? oszlop évszáma kisebb, mint 2000. Hol adod meg az évszámot? A makróban?

Szia!

igen, pont erre lenne szükségem, hogy ezt hogyan lehet megoldani? Csak makróval vagy könnyebben is függvények segítségével?
Évszámot egy sima HA függvénnyel, ha igaz akkor egyik sor egyenlő a másikkal, ha nem akkor nem csinál semmit. Ezzel az a baj hogy maradnak üres sorok az új munkafüzet lapon...

[Delila]

Idézet: elbandita - Dátum: 2012. 10. 19. 07:15

Szia!

igen, pont erre lenne szükségem, hogy ezt hogyan lehet megoldani? Csak makróval vagy könnyebben is függvények segítségével?
Évszámot egy sima HA függvénnyel, ha igaz akkor egyik sor egyenlő a másikkal, ha nem akkor nem csinál semmit. Ezzel az a baj hogy maradnak üres sorok az új munkafüzet lapon...

Ha továbbra is titokként kezeled az általam kérdőjelekkel helyettesített oszlopcímeket, hiába vársz segítséget.

[elbandita]

Idézet: Delila - Dátum: 2012. 10. 19. 12:33

Ha továbbra is titokként kezeled az általam kérdőjelekkel helyettesített oszlopcímeket, hiába vársz segítséget.

Szia, bocsi, most már felfogtam...

1. füzetben lévő adatokból át kell másolni azokat az adatokat 3. füzetben amelyek 2. füzetben nincsenek benne. A két füzetben ugyanazok az oszlopok szerepelnek. Egyébként a keresést C oszlop alapján kell végezni. Azaz ha 1. füzet pl. 5 sorának C oszlopában lévő érték megtalálható a 2. füzet bármelyik sorának C oszlopában akkor azt nem kell másolni, viszont ha egyik sorban sem található, akkor 1. füzet teljes 5. sorát át kell másolni 3. füzetbe. Majd ha ez végzet, akkor a 3. füzethez hozzá kell másolni azokat a 2. füzet beli sorokat amelyek E oszlop szerint (dátum) viszgálva egy pl. 2012.10.01. értéket tartalmaznak. Évszámot egy tetszőleges cellában adnék meg.

Köszönöm!

Szerkesztette: elbandita 2012. 10. 19. 11:21 -kor

[Delila]

elbandita

Célszerűen az 1.xls-be írd a makrót. A csillagozott sorokban írd át az adatokat a saját füzeteid és lapjaid nevére, és az EV változónak az általad választott évet add meg.
Mindhárom füzet legyen megnyitva, a 3.xls-ben is legyen meg a címsor az indítás előtt.

Ne zavarjon a tili-tarka makró, a fórummotor szeret ilyen cifrára színezni.

Sub Szortiroz()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim sor%, usor%, sorM%, EV
    Set WS1 = Workbooks("1.xls").Sheets("Munka1")   '***
    Set WS2 = Workbooks("2.xls").Sheets("Munka1")   '***
    Set WS3 = Workbooks("3.xls").Sheets("Munka1")   '***
    EV = 2010   '***
    sorM% = 2
    WS1.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
    WS2.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Year(Cells(sor%, 5)) = EV Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
End Sub

[csozsi]

Következő kérdés. (office 2003 és/vagy 2007)
Mostanában igen sűrűn kell nyomkodnom a cellaszín, és betűszín gombokat.
Lehet e a menüsorra (vagy bárhová) gyorsgombokat kreálni (piros, sárga, zöld hátterek, piros, sárga, zöld betűszínek)?
A menüből kiválogatás nem jó, nagyon lassítja a munkafolyamatot.

[Delila]

csozsi

A 2003-as verziónál a színező paneleket a felső szürke csíkjuknál fogva lehúzhatod a szerkesztő felületre, és ott kattintgathatsz rá.
Magasabb verzióban ezt megszüntették, de makrókkal megoldható. A makrókat a personal.xlsb-be (egyéni makró-munkafüzetbe) kell bevinned, hogy minden megnyitott füzetben alkalmazhasd.

Sub PirosHáttér()
    Selection.Interior.ColorIndex = 3
End Sub

Sub PirosBetü()
    Selection.Font.ColorIndex = 3
End Sub

A sárga szín colorindexe 6, a zöldé 10, azokhoz is külön makrókat kell írnod. Minegyikhez kitehetsz 1-1 ikont, amikre kattintva a kijelölt cella (cellák) színe megváltozik.
Régebbi verzióban is alkalmazhatsz ilyen makrókat, ikonokat, sőt, a régebbiekben magad alakíthatod az ikon képét, míg 2007-től csak az Excel által ajánlott rajzokat rendelheted az ikonokhoz.

[csozsi]

Idézet: Delila - Dátum: 2012. 10. 21. 17:12

csozsi

A 2003-as verziónál a színező paneleket a felső szürke csíkjuknál fogva lehúzhatod a szerkesztő felületre, és ott kattintgathatsz rá.
Magasabb verzióban ezt megszüntették, de makrókkal megoldható. A makrókat a personal.xlsb-be (egyéni makró-munkafüzetbe) kell bevinned, hogy minden megnyitott füzetben alkalmazhasd.

Sub PirosHáttér()
    Selection.Interior.ColorIndex = 3
End Sub

Sub PirosBetü()
    Selection.Font.ColorIndex = 3
End Sub

A sárga szín colorindexe 6, a zöldé 10, azokhoz is külön makrókat kell írnod. Minegyikhez kitehetsz 1-1 ikont, amikre kattintva a kijelölt cella (cellák) színe megváltozik.
Régebbi verzióban is alkalmazhatsz ilyen makrókat, ikonokat, sőt, a régebbiekben magad alakíthatod az ikon képét, míg 2007-től csak az Excel által ajánlott rajzokat rendelheted az ikonokhoz.

Köszönöm.
Valamit biztos nem jól csinálok, mert nem az lesz belőle, amit szeretnék.
Ha papíron lenne, filctollakkal pillanatok alatt végeznék vele. De ez egy többszáz tagú adat, diktálásra kell jelölni a jókat, és rosszakat, kb 15-20 másodperc alatt. Majd megkeresni a fájlhoz kapcsolódó munkában a "hibákat", ezután a fájlban módosítani a hibásat jóra.
Érdekesség, hogy ami 15"-os laptopon nem (1280x800, az 17"-oson látszik (1600x900), mégpedig a "Kezdőlap" fül "cellastílusok" gyorsszínei (jó, rossz, semleges), kb ilyen kellene.

 excel1.png (18,9K)
Letöltések:: 13

[Delila]

csozsi

Úgy látom, csak ebben a füzetben lesz szükséged a gyors színezésre, és csak a 2 háttérre, ezért ebbe a füzetbe írd a 2 hátteres makrót. A csatolt kép szerinti zöld colorindexe 43.

Ikonok a füzethez:
2003-hoz:
Testreszabás menü, Parancsok fül, Makrók kategória, jobb oldalról húzd fel az ikonsorra (Eszköztárra) a vigyori fejet. Ne zárd be a Testreszabás menüt. Ikonon jobb klikk, megadod a nevet, és hozzárendeled a megfelelő makrót. Újabb jobb klikk az ikonon, Gombkép szerkesztése. Itt rajzolsz egy képet, célszerűen egy piros (zöld) négyzetet.

2007:
A Gyorselérési eszköztár jobb oldalán lévő legördülőben a További parancsokat választod. A Választható parancsok helye legördülőből a Makrókat jelöld meg, a két makródat a Felvétel gombbal másold át a jobb oldali területre. Az átkerült elemet kiválasztva engedélyezetté válik a Módosítás gomb, aminek a segítségével sok szép rajz közül válogathatsz – csak olyan nem lesz közöttük, ami utalna a makró feladatára.

Mielőtt megkérdezed, csatolok egy rövid kis makrót, ami megmondja, hogy az általad kiszínezett hátterű és karakterű cellában mi ennek a 2 színnek a colorindexe.

Sub Szin_lekerdezes()
    MsgBox "Karakter: " & Selection.Font.ColorIndex & Chr(10) & _
        "Háttér: " & Selection.Interior.ColorIndex
End Sub

Szerkesztette: Delila 2012. 10. 22. 07:11 -kor

[csozsi]

Kezdem feladni. A 2003-ban annyi színgombot húzok fel, amennyi jólesik. De minek? Ha egyet átállítok más színre, mind átáll ugyanarra.
Az "Úgy látom, csak ebben a füzetben lesz szükséged a gyors színezésre" az heti 2-4 táblázat, ami a munka "papíralapú" része. Küldik, ahogy sikerül, nekem módosítanom kell, és dolgozni belőle, majd a változásokat beleírni.
Egy munkafüzetben 150-600-1500 tételt kell egyeztetni, a 600 megvan ~1200 perc alatt, ha az alapadat jó.
A javítás darabonkét 5-30 perc is lehet.

[Delila]

csozsi

Ha minden (sok) füzetedben alkalmazni akarod a makrókat, a personal-ba kell beírnod. Ennek a létrehozása legegyszerűbben úgy lehetséges, hogy indítasz egy makrórögzítést. A makró helye az "Egyéni makró-munkafüzet" legyen. Indítás után azonnal le is állítod. Ezzel létrehoztad a personal.xls-t a 2003-as verzióban, ill. a personal.xlsb-t a 2007-ben.

Most a VB szerkesztőben bal oldalon kiválasztod a personalt, és a rögzített üres makró helyére bemásolod ezt a kettőt:

Sub Piros()
    Selection.Interior.ColorIndex = 3
End Sub

Sub Zold()
    Selection.Interior.ColorIndex = 43
End Sub

Ez a füzet automatikusan elmentődik a
C:\Documents and Settings\Felhasználó\Application Data\Microsoft\Excel\XLSTART könyvtárba, innen tölti be az Excel minden indításakor rejtetten a háttérben, és minden megnyitott füzetben használhatod a makróit.

Valamit rosszul csináltál, ha 1 cella háttérszínének a módosítása az összes többiét magával vonja. Csak rá kell állnod a színezendőre, katt a megfelelő ikonra, és kész.

[elbandita]

Idézet: Delila - Dátum: 2012. 10. 19. 18:39

elbandita

Célszerűen az 1.xls-be írd a makrót. A csillagozott sorokban írd át az adatokat a saját füzeteid és lapjaid nevére, és az EV változónak az általad választott évet add meg.
Mindhárom füzet legyen megnyitva, a 3.xls-ben is legyen meg a címsor az indítás előtt.

Ne zavarjon a tili-tarka makró, a fórummotor szeret ilyen cifrára színezni.

Sub Szortiroz()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim sor%, usor%, sorM%, EV
    Set WS1 = Workbooks("1.xls").Sheets("Munka1")   '***
    Set WS2 = Workbooks("2.xls").Sheets("Munka1")   '***
    Set WS3 = Workbooks("3.xls").Sheets("Munka1")   '***
    EV = 2010   '***
    sorM% = 2
    WS1.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
    WS2.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Year(Cells(sor%, 5)) = EV Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
End Sub

Köszönöm szépen! Szuperül működik!
Azt szeretném még kérdezni, hogy ez az egész hogyan módosulna akkor, hogy ha a 2.xls-ből nem csak pl.:2010 év szerint szeretnék szűrni hanem év.hónap.nap (2012.10.01.) alapján. Nekem az adatbázisban év.hónap.nap is van és sok helyen fontos az is hogy napra pontos legyen a szűrés. Illetve: "If Year(Cells(sor%, 5)) = EV Then" itt nekem az kellett ami EV előtti tehát a = átírtam < így már jó lett.

[Delila]

elbandita

Teljes dátum szerinti szűrés:

Sub Szortiroz()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim sor%, usor%, sorM%, Ido As Date
    Set WS1 = Workbooks("1.xls").Sheets("Munka1")   '***
    Set WS2 = Workbooks("2.xls").Sheets("Munka1")   '***
    Set WS3 = Workbooks("3.xls").Sheets("Munka1")   '***
    Ido = CDate("2010.06.14")   '***
    sorM% = 2
    WS1.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
    WS2.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Cells(sor%, 5) = Ido Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
End Sub

[elbandita]

Idézet: Delila - Dátum: 2012. 10. 23. 16:57

elbandita

Teljes dátum szerinti szűrés:

Sub Szortiroz()
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Dim sor%, usor%, sorM%, Ido As Date
    Set WS1 = Workbooks("1.xls").Sheets("Munka1")   '***
    Set WS2 = Workbooks("2.xls").Sheets("Munka1")   '***
    Set WS3 = Workbooks("3.xls").Sheets("Munka1")   '***
    Ido = CDate("2010.06.14")   '***
    sorM% = 2
    WS1.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Application.WorksheetFunction.CountIf(WS2.Columns(3), Cells(sor%, 3)) = 0 Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
    WS2.Activate
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
        If Cells(sor%, 5) = Ido Then
            Rows(sor%).Copy WS3.Range("A" & sorM%)
            sorM% = sorM% + 1
        End If
    Next
End Sub

Nagyon köszönöm!

És ez az egész áttehető access-re érvényes makrová is. Most probáltam vele küzdeni de nekem sehogy sem ment, kicsit mások a definiciók. És lehet hogy ott is működnie kéne...