-
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
-
válasz
bozsozso
#14147
üzenetére
Public Sub FSCD_Summary_Bozsozso()
Dim MyCurDate As Range
Dim MySrcStartCell As Range, MyDestStarCell As Range
Dim MySrcWS As Worksheet, MyDestWS As Worksheet
Dim MyFXs As WorksheetFunction
Set MyFXs = Application.WorksheetFunction
'MUNKALAP neve, amely a jelenléti ívet tartalmazza
Set MySrcWS = Worksheets("Jelenléti")
'MUNKALAP neve, amelyen az összesítés található
Set MyDestWS = Worksheets("Összesítő")
'A jelenléti munkalapon találhat IDŐCELLA címe
Set MyCurDate = MySrcWS.Range("$A$2")
'Jelenléti munkalapon ettől a cellától kezdődnek az adatok
Set MySrcStartCell = MySrcWS.Range("A9")
'Összesítő munkalapon ettől a cellától kell bemásolni az adatokat
Set MyDestStarCell = MyDestWS.Range("A1")
j = 0
For i = 0 To Day(MyFXs.EoMonth(MyCurDate, 0)) - 1
If Not IsEmpty(MySrcStartCell.Offset(i, 13)) Then
MyDestStarCell.Offset(j, 0).NumberFormat = "yyyy-mm-dd"
MyDestStarCell.Offset(j, 0) = Format(MyCurDate, "yyyy-mm-") & Format(i + 1, "00")
MyDestStarCell.Offset(j, 1) = MySrcStartCell.Offset(i, 13)
MyDestStarCell.Offset(j, 4).NumberFormat = "[h]:mm"
MyDestStarCell.Offset(j, 4) = Format(MySrcStartCell.Offset(i, 2), "0:") & Format(MySrcStartCell.Offset(i, 3), "00")
MyDestStarCell.Offset(j, 5).NumberFormat = "[h]:mm"
MyDestStarCell.Offset(j, 5) = Format(MySrcStartCell.Offset(i, 4), "0:") & Format(MySrcStartCell.Offset(i, 5), "00")
MyDestStarCell.Offset(j, 6) = MySrcStartCell.Offset(i, 11)
j = j + 1
End If
Next i
End SubAz összesítő munkalap tartalmát nem törli a makró, mert a korábbi kép alapján nem tudhattam, hogy az összesítő munkalapon vannak-e még más adatok is, ezért a makró futtatása előtt manuálisan töröld az összesítő munkalapon lévő adatokat.
Új hozzászólás Aktív témák
- Crimson Desert
- The Division 2 (PC, XO, PS4)
- Hitelkártyák használata, hitelkártya visszatérítés
- Budapest és környéke adok-veszek-beszélgetek
- Yettel topik
- Pura color: színkavalkádba bújt a Huawei legjobb kameratelefonja
- Futás, futópályák
- Allegro vélemények - tapasztalatok
- Motoros topic
- Kerékpárosok, bringások ide!
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Eladó jogtiszta, Windows 11/10, Office 2019/2021/2024, Fizikai és Digitális licencek, Számlával.
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- iPhone X 64GB 100% (3hónap Garancia)
- BESZÁMÍTÁS! Apple Macbook Air 13 M4 16GB RAM 256GB SSD notebook garanciával hibátlan működéssel
- Motorola Edge 40 / 8/256GB / Kártyafüggetlen / 12Hó Garancia
- 0perces DDR5 5600 vadiúj 2x16GB memória 1 év garancia
- Apple iPhone Air - Black - 512GB - Újszerű - ALZA Jótállás: 2028.09.28-ig
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50