Hirdetés
- Riasztó topik
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Nagyon gyorsan búcsút mondhatunk az olcsó notebookoknak
- Vezeték nélküli fülhallgatók
- Milyen TV-t vegyek?
- Külső merevlemezek - USB, eSATA, FireWire HDD
- Bluetooth hangszórók
- VR topik
- Milyen egeret válasszak?
- Azonnali informatikai kérdések órája
-
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
-
Cifu
félisten
válasz
Árnymester
#26982
üzenetére
Próbálkozom, de sehogy sem sikerül....

A probléma (ha jól látom) a következő:
A nekem nem külön munkalapokra, hanem komplett excell fájlokba kellene másolnom, tehát a '2014q3.xlsx' fájl 'munkalap1' munkalapján vannak az adatok, a második oszlopba vannak a vonalkódok, aztán az adatok a következőkbe (pár oszlop lényegtelen a számomra).
Ezekből kéne 'C oszlop' nevű új workbookot (.xlsx) fájlt létrehozni, amelybe átmásolom az adott sor bizonyos celláinak tartalmát, majd a fájlt bezárni, és folytatni a következő sorral.
Szóval valami ilyesmi lenne (csak ez még mindig nem működik
):Sub WorkbooksAdd()
Dim munkalap1 As Worksheet
Dim wborig As Workbook
Dim r As Integer, count As IntegerSet wborig = "2014q3_int.xlsx"
Set munkalap1 = ActiveSheet
r = 5
Do Until Not IsEmpty(munkalap1(r, B))Application.ScreenUpdating = False
y = (wborig.munkalap1(r, C)
strPath = ThisWorkbook.Path
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=y.Name
'Címsor másolása
ActiveSheet.Cells(1, 1).Value = wborig.munkalap1.Cells(4, B)
ActiveSheet.Cells(1, 2).Value = wborig.munkalap1.Cells(4, C)
ActiveSheet.Cells(1, 3).Value = wborig.munkalap1.Cells(4, D)
ActiveSheet.Cells(1, 4).Value = wborig.munkalap1.Cells(4, K)
ActiveSheet.Cells(1, 5).Value = wborig.munkalap1.Cells(4, T)
'Adatok másolása
ActiveSheet.Cells(2, 1).Value = wborig.munkalap1.Cells(r, B)
ActiveSheet.Cells(2, 2).Value = wborig.munkalap1.Cells(r, C)
ActiveSheet.Cells(2, 3).Value = wborig.munkalap1.Cells(r, D)
ActiveSheet.Cells(2, 4).Value = wborig.munkalap1.Cells(r, K)
ActiveSheet.Cells(2, 5).Value = wborig.munkalap1.Cells(r, T)For Each wb In Application.Workbooks
If Not wb.Name = ThisWorkbook.Name Then wb.Close SaveChanges:=Truer = r + 1
LoopApplication.ScreenUpdating = True
End Sub
-
Delila_1
veterán
válasz
Árnymester
#26973
üzenetére
Erre a feladatra nem készült fel az MS, mert állítólag közel-távol csak nálunk gyakorlat a munkanapok áthelyezése.
-
Fferi50
Topikgazda
válasz
Árnymester
#26951
üzenetére
Szia!
Nem tudom milyen excel verziód van...
2010-től már létezik az ÖSSZ.MUNKANAP.INTL (NetworkDays_Intl) függvény, amelynek megadhatod, hogy mely napok számítanak ünnepnapnak.
Paraméterek: Kezdő nap, Befejező nap, Hétvége jele (itt több variációt is megadhatsz, pl. hogy csak vasárnap a hétvége), Ünnepnapok
Ha például megadod, hogy csak vasárnap a hétvége, az ünnepnapok között felsorolod az összes nem dolgozós szombatot is a tényleges ünnepek mellett, akkor jól fog számolni.Üdv.
-
Delila_1
veterán
válasz
Árnymester
#26965
üzenetére
Köszi a rangot

-
Delila_1
veterán
válasz
Árnymester
#26961
üzenetére
Jó lenne, amit írtam, ha nem hagyom ki belőle a szombat és vasárnap kivonását. Így jár, aki kapkod.
Hétvégékkel a makró
Function Munkanap(kezd As Date, vegez As Date)
Dim MN As Integer, ido As Integer, valami
MN = vegez - kezd
For ido = 0 To MN
valami = kezd + ido
If Weekday(valami, 2) > 5 Then MN = MN - 1
If Application.WorksheetFunction.CountIf(Range("E1:E20"), valami) > 0 Then MN = MN - 1
If Application.WorksheetFunction.CountIf(Range("G1:G10"), valami) > 0 Then MN = MN + 1
Next
Munkanap = MN
End FunctionSzerk: magyarázat
A kezd dátumhoz a For-Next ciklusban egyenként hozzáadom a két dátum közötti különbséget. Ha a kezd=2015.04.03, akkor a ciklusban az első érték ugyanez lesz (mert közben rájöttem, hogy ha 1-gyel kezdem a ciklust, az első napot nem veszi figyelembe). Ha ez a nap ünnep (szerepel az E oszlopban), vagy hétvége, akkor az össznapból (MN) levon 1-et. Ha viszont szombat, és munkanap, akkor hozzáad az MN-hez 1-et.
A ciklusban a következő esetben a 2015.04.04-et vizsgálja hasonló módon. -
Delila_1
veterán
válasz
Árnymester
#26953
üzenetére
Rosszul írtam, felcseréltem a + és - jelet a két If kezdetű sorban. Bocsi, írd át!
-
Delila_1
veterán
válasz
Árnymester
#26953
üzenetére
Írtam hozzá egy felhasználói függvényt. Az ünnepnapokat az E1:E20; a rendkívüli munkanapokat a G1:G10 tartományba írtam be. Ezt a két tartományt írd át a makróban a saját területeidre.
Function Munkanap(kezd As Date, vegez As Date)
Dim MN As Integer, ido As Integer, valami
MN = vegez - kezd
For ido = 1 To MN
valami = kezd + ido
If Application.WorksheetFunction.CountIf(Range("E1:E20"), valami) > 0 Then MN = MN + 1
If Application.WorksheetFunction.CountIf(Range("G1:G10"), valami) > 0 Then MN = MN - 1
Next
Munkanap = MN
End FunctionA függvény alkalmazása:
=munkanap(A3;A2), ahol az A2 a kezdő-, A3 a végző dátum.
-
Delila_1
veterán
válasz
Árnymester
#26951
üzenetére
A NETWORKDAYS függvényt használd. Ennek az utolsó paramétere az a tartomány legyen, ahol az év ünnepnapjait megadod.
Új hozzászólás Aktív témák
- Vigneau interaktív lokálblogja
- Lexus, Toyota topik
- Építő/felújító topik
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Hardcore café
- Brogyi: CTEK akkumulátor töltő és másolatai
- Riasztó topik
- ASUS routerek
- Tudományos Pandémia Klub
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- További aktív témák...
- PC Game Pass előfizetés
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Játékkulcsok : ! Legjobb Áron ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.10.)
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- BLACK FRIDAY! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Bomba ár! Acer Travelmate X314 - i5-8GEN I 8GB I 256SSD I 13,3" FHD I Cam I W11 I Garancia!
- iKing.Hu - Google Pixel 10 Tensor G5, 120 Hz OLED, tripla kamera-128 GB Használt, karcmentes Gari
- Apple iPhone 12 Mini 64GB, Kártyafüggetlen, 1 Év Garanciával
- HP ProDesk 600 G5 i5-9500 8GB 256GB 1 év garancia
- Apple iPhone 12 Mini 128 GB Fekete 1 év Garancia Beszámítás Házhozszállítás
Állásajánlatok
Cég: BroadBit Hungary Kft.
Város: Budakeszi
Cég: ATW Internet Kft.
Város: Budapest

):

Fferi50

