2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
Keresés

Hirdetés

  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    PROHARDVER!

    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

  • #26982 Árnymester tag Cifu #26981
    Új Válasz #26982
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Árnymester

    tag

    válasz Cifu #26981 üzenetére

    Lehet nem a legelegánsabb megoldás...

    Sub Szetszed()
    Dim MyWs As Worksheet
    Set MyWs = ActiveSheet
    'Az első másolandó sor száma
    r = 1
    Do Until Not IsEmpty(MyWs.Cells(r, 1)) 'Ide olyan oszlopot adj meg, ami minden sorban tartalmaz adatot!
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    'Ide jönnek az oszlopok, a c1-c5-ök helyére a forrás(MyWs) értékes oszlopait kell beírni.
    'Címsor másolása
    ActiveSheet.Cells(1, 1).Value = MyWs.Cells(1, c1)
    ActiveSheet.Cells(1, 2).Value = MyWs.Cells(1, c2)
    ActiveSheet.Cells(1, 3).Value = MyWs.Cells(1, c3)
    ActiveSheet.Cells(1, 4).Value = MyWs.Cells(1, c4)
    ActiveSheet.Cells(1, 5).Value = MyWs.Cells(1, c5)
    'Adatok másolása
    ActiveSheet.Cells(1, 1).Value = MyWs.Cells(r, c1)
    ActiveSheet.Cells(1, 2).Value = MyWs.Cells(r, c2)
    ActiveSheet.Cells(1, 3).Value = MyWs.Cells(r, c3)
    ActiveSheet.Cells(1, 4).Value = MyWs.Cells(r, c4)
    ActiveSheet.Cells(1, 5).Value = MyWs.Cells(r, c5)
    r = r + 1
    Loop
    End Sub

    [ Szerkesztve ]

    The Trouth Is Out There... Follow The White Rabbit! Teakwondo, Aikido, Jiujitsu - önálló életet élnek, én csak a hordozó vagyok...

  • #26983 Louro őstag Cifu #26981
    Új Válasz #26983
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Louro

    őstag

    válasz Cifu #26981 üzenetére

    Ööö, elsőre nem tűnik vészesnek. Adott egy forrástábla. Pl. Első munkalapon. Második munkalpra vagy a táblázat mellé új oszlopokba akarsz kalkulált értékeket.

    Vegyük utóbbit.

    Én úgy csinálnám, hogy

    Range(Cells(2,ActiveSheet.UsedRange.Columns.Count+1),Cells(ActiveSheet.UsedRange.Rows.Count,ActiveSheet.UsedRange.Columns.Count+1)) = "=A2+D2/F2"

    Range() : Hol is akarunk dolgozni. -tól -ig. Ezért kell két cellát megadni.
    ActiveSheet.UsedRange.Columns.Count : Az aktív munkalap kitöltöttségének utolsó oszlopának sorszáma. Mivel nem az utolsót akarjuk felülírni, hanem mellé tenni, ezért a +1.

    Remélem ez valamicskét segít.

    Különben lehet akár 10000+ sor is. Első függvényt megírva már csak másolni kell a függvényt :) (Jobb alsó sarokra kattintva.) Oszloponként pedig elég felülírni az értékeket, hogy ne kalkulálja mindig elölről mindig az egészet.

    [ Szerkesztve ]

    Mess with the best / Die like the rest

  • #27003 Louro őstag Cifu #27002
    Új Válasz #27003
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Louro

    őstag

    válasz Cifu #27002 üzenetére

    Szia,

    ha jól értem annyi fájlt akarsz, ahány sorod van -1 (a fejléc miatt).

    Ha igen, akkor ciklussal addig mennék ahány sor van. Megkommenteztem a kódot, de nem teszteltem. De hátha a logikai út segít.

    Dim SourceBook, NewBook as Workbook

    Set SourceBook = ActiveWorkbook

    For i = 2 to ActiveSheet.UsedRange.Rows.Count 'Ha nincs fejléc, akkor mehet 1-ről is

    Set NewBook = Workbooks.Add

    'Itt első oszloptól 10. oszlopig mindent másol. De a logika alapján talán már megvan miképp tudsz
    'kiszedni cellákat.
    SourceBook.Worksheets("A munkalap neve").Range(Cells(i,1),Cells(i,10)) = _
    NewBook.Worksheets(1).Range(Cells(1,1),Cells(1,10))

    'Mentsük el a fájlt a sorszám alapján és zárjuk be. Majd ugrás a következőre. Fájlnévnek fontos,
    'hogy a változót tedd be, hogy ne legyen ütközés. Akár Filename:="Tesco_tej_" & i & ".xlsx"
    NewBook.Close Filename:= i & ".xlsx", SaveChanges:=True

    Next

    [ Szerkesztve ]

    Mess with the best / Die like the rest

  • #27009 tombar senior tag Cifu #27006
    Új Válasz #27009
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    tombar

    senior tag

    válasz Cifu #27006 üzenetére

    + (#27008) Louro

    mind2t próbáltam. az a para h túl nagy maga az aktív cella tartomány és valszeg már nem tudja olyan kicsire összenyomni. legalábbis ezt onnan szűröm le h a custom sclaing-nél nem engedi tovább kicsinyíteni, mint 10% :( alapvetően nagy méretre szabták az eredeti méretet. a vicces az h egyszer ki lett nyomtatva, de nem tudják h hogyan :))
    azért köszönöm szépen :)

    [ Szerkesztve ]

    Everybody knows, you dance like you fuck. So let me see you dance!

Új hozzászólás Aktív témák