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

• #27009 tombar senior tag Cifu #27006

  Új Válasz 2015-05-20 15:13:24 #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

• #27003 Louro őstag Cifu #27002

  Új Válasz 2015-05-20 13:57:12 #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

• #26983 Louro őstag Cifu #26981

  Új Válasz 2015-05-19 12:59:12 #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.

• #26982 Árnymester tag Cifu #26981

  Új Válasz 2015-05-19 12:57:34 #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

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