-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
wjani
tag
válasz core1113 #5029 üzenetére
Szia!
Ezeket, gondolom egy gombnyomásra akarod indítani, ugye?
Az elsőnél, még megoldható valami hivatkozás képletekkel, de a törlés, szerintem már nem megy, így lehetséges, hogy inkább az egészet egy makróval kell megcsinálni.
A másodiknál az a kérdés, hogy neked annyi munkalap fül lesz, amennyi irányítószám van, vagy csoportosítod. Ezt pedig csak makróval lehetne megoldani.Üdv
WjaniCoViA Online könyvkereskedés,
-
Cuci3
tag
válasz core1113 #5029 üzenetére
A másodikra tudok makrót küldeni/beszúrni.
Csináltam nemrég egy ilyet, ahol egy makró egy munkafüzetben ömlesztett adatokat egy másik munkafüzetbe szétszedi végrehajtók nevei alapján külön munkalapokra.
Kérdés:
1. Milyen sorrend legyen az irányítószámokra? Tehát ha Excel sorbarendezővel sorba rakom, akkor az elég-e?
2. Ugyanabba a munkafüzetbe kell szétszedni, vagy külön munkafüzetbe?
3. Gondolom az irányítószámnak meg kellene jelnnie a munkalap nevénél. Kell valami buherálás az irányítószámokkal? Pl nálam a neveknél kellett, mivel egy munkalap neve max 31 karakter hosszú lehet.De ezt csak délután tudom küldeni, mivel délelőtt szaladgálok két iroda között.
Ja és persze az első is megoldható makróval, de meg lehet úgy is oldani, hogy külön munkalapra beképletezed, majd onnan kimásolod.
[ Szerkesztve ]
-
wjani
tag
válasz core1113 #5035 üzenetére
Szia itt a kód:
Sub átemelés()
'
' átemelés Makró
'
'=========================================================================================
'Ez a makró egy adott oldal első oszlopának adatait emeli át egy mások munkalapra úgy, hogy
'az első oszlop eslő értéke az első oszlopba, az első oszlop második sorának értéke a
'a második oszlopba, az első oszlop harmadik értéke a harmadik oszlopba kerül.
'
'A zárójelben Munka1 és Munka2 értékeket cseréld le a te munkalapjaid nevére, de pontosan
'Készítette: Weisz János, wjani@freemail.hu
'=========================================================================================
'Első és második munkafüzet változóinak felvétele,
Dim i, j As Variant
'A sor változók megadása
Dim s, o, m, n As Integer
'A sor kezdő értékeinek megadása
s = 1
o = 1
m = 1
n = 1
' Egy ciklus ami addig megy, amíg az első munkalapon az első üres sort nem talál
Do
' Az első érték felvétele a változóba
i = Worksheets("Munka1").Cells(s, o).Value
' Ez a ciklus második oldalon fogja az adatokat átadni
Do
'Az első érték felvétele a változóba
j = Worksheets("Munka2").Cells(m, n).Value
'Ha az első cella értéke üres, tegye bele az értékeket a megadott cellákba
If j = Empty Then
'első cella értéke legyen egyenlő az első cella értékével
Worksheets("Munka2").Cells(m, n).Value = Worksheets("Munka1").Cells(s, o).Value
'második cella értéke legyen egyenlő a második sor első cellájának értékével
Worksheets("Munka2").Cells(m, n + 1).Value = Worksheets("Munka1").Cells(s + 1, o).Value
'harmadik cella értéke legyen egyenlő a harmadik sor első cewllájának értékével.
Worksheets("Munka2").Cells(m, n + 2).Value = Worksheets("Munka1").Cells(s + 2, o).Value
'lépjen ki a ciklusból
Exit Do
'Ha a cella értéke nem üres
Else
'A második lap első oszlopában ugorjon a következő sorba
m = m + 1
'Feltétel vége
End If
' Addig fusson a ciklus, amíg a második lap első oszlopának a sorában üres nem lesz a cella
Loop Until j = Empty
'Első munkalap első oszlopában ugorjon 3 cellával lejebb
s = s + 3
Loop Until i = Empty
'Üzenet ha a feladatot végrehajtotta
MsgBox "Az adatok átemelése megtörtént", vbInformation, "Üzenet a feladat végrehajtásáról!"
End SubEz tedd bele abba a makróba, amit létrehozól.
A makró elején leírtam, hogy mit csinál, minden részre odaírtam a magyarázót.
Ha valamit nem megy, vagy nem érted jelezz.
ÜdvWjani
CoViA Online könyvkereskedés,
-
wjani
tag
válasz core1113 #5034 üzenetére
Erre azt tudom ajánlani, hogy a makróban kell megadni, hogy melyik sor melyik munkalap fülre ugorjon.
Az egyben lévő adatoknál azért kell lennie olyan oszlopnak, ahol ezt össze lehet vetni (megyék neve), vagy pedig egy külön munkalapon az irányítószámok és mellette, a megye neve.
Így átemelhető.Üdv
WjaniCoViA Online könyvkereskedés,
-
Cuci3
tag
válasz core1113 #5034 üzenetére
Az első kérdésedhez [itt] egy bemutató. Az index függvénnyt használtam. Nem tudom pontosan hol vannak az adataid, de a sor függvénnyel kell szórakozni hozzá, hogy jó legyen. Ajánlom, hogy teszteld előbb fals, azaz ilyen számokat tartalmazó adatokkal.
A második kérdés folyamatban, csak előbb saját melómmal is törődnöm kellene.
-
Delila_1
Topikgazda
válasz core1113 #5029 üzenetére
Írtam egy makrós megoldást a 2. kérdésedre.
A munka1 kiinduló lapon az A oszlopban vannak az irányítószámok, B oszlopban a megyék nevei, a többiben bármilyen adat.
A többi lap neve pontosan egyezzen meg a B oszlop adataival.
Minden lapon van címsor.
A "Sheets(Array(" kezdetű sorban írd át a megyék nevét.Sub Irszám()
Application.ScreenUpdating = False 'Képernyő frissítés tiltása
'Előző adatok törlése a megyék lapjain.
Sheets(Array("Pest", "Borsod", "Hajdú", "Zala", "Szolnok")).Select
Rows("2:6000").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
'Sorok másolása a lapokra
Sheets("Munka1").Select
For sor = 2 To ActiveSheet.UsedRange.Rows.Count
megye = Cells(sor, 2)
Rows(sor & ":" & sor).Copy
Sheets(megye).Select
Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
ActiveSheet.Paste
Sheets("Munka1").Select
Next
Sheets("Munka1").Select: Range("A2").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True 'Képernyő frissítés engedélyezése
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- Eredeti Windows, telepítéssel! Digital Doctor Számítógép Szerviz
- Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- World of Warcraft Shadowlands Collectors edition EU EN
- Microsoft licencek a KIVÉTELES ÁRAK - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.