-
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
-
Delila_1
veterán
válasz
kokopeti
#15509
üzenetére
A 'Napi összesítő' lap A2 cellája a mód, B2 a bruttó, C2 a nettó, D2 a megjegyzés.
A laphoz rendeld ezt a makrót:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim datum As Date
If Target.Address = "$A$1" Then
Application.EnableEvents = False
datum = Target.Value
Osszevonas datum
Application.EnableEvents = True
End If
End SubModulba tedd a másikat:
Sub Osszevonas(datum)
Dim sor%, usor%, usorN%, f As Boolean
Application.ScreenUpdating = False
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Set WS1 = Worksheets("Kiadások")
Set WS2 = Worksheets("Bevételek")
Set WS3 = Worksheets("Napi összesítő")
WS1.Select
usor% = Cells(Rows.Count, "A").End(xlUp).Row
usorN% = 2
For sor% = 2 To usor%
If Cells(sor%, 1) = datum Then
usorN% = usorN% + 1
f = True
WS3.Cells(usorN%, 1) = Cells(sor%, 2)
WS3.Cells(usorN%, 2) = Cells(sor%, 3) * -1
WS3.Cells(usorN%, 3) = WS3.Cells(usorN%, 2) / 1.27
WS3.Cells(usorN%, 4) = Cells(sor%, 5)
End If
Next
WS2.Select
usor% = Cells(Rows.Count, "A").End(xlUp).Row
For sor% = 2 To usor%
If Cells(sor%, 1) = datum Then
f = True
usorN% = usorN% + 1
WS3.Cells(usorN%, 1) = Cells(sor%, 2)
WS3.Cells(usorN%, 2) = Cells(sor%, 3)
WS3.Cells(usorN%, 3) = WS3.Cells(usorN%, 2) / 1.27
WS3.Cells(usorN%, 4) = Cells(sor%, 4)
End If
Next
WS3.Select
Application.ScreenUpdating = True
If f = False Then MsgBox "Nincs mozgás a " & datum & " napon."
End SubAz összes bruttót az =szum(B:B), az összes nettót az =szum(D:D) képlet számolja ki a harmadik lapodon.
Új hozzászólás Aktív témák
- Milyen házat vegyek?
- Kertészet, mezőgazdaság topik
- Samsung Galaxy Felhasználók OFF topicja
- Gyúrósok ide!
- iRacing.com - a legélethűbb -online- autós szimulátor bajnokság
- Nintendo Switch 2
- Sokkal jobb ajánlat lett elődjénél az iPhone 17e
- EAFC 26
- MWC 2026: Kezünkben a frissen bemutatott Motorola Edge 70 Fusion
- Allegro vélemények - tapasztalatok
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Microsoft és egyéb dobozos retro szoftverek
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- szinteÚJ 2030 Gar! Dell Pro Max 14 Ryzen AI 9 HX PRO 370 32GB LPDDR5X 512GB NVMe SSD
- AZONNAL KÉSZLETRŐL! Intel Core i5 14600K 32GB 6000MHz RAM 2TB Gen4 SSD RTX 5060 8GB FSP 750W
- LG 27GR95UM - 27" MiniLED - UHD 4K - 160Hz 1ms - NVIDIA G-Sync - FreeSync Premium PRO - HDR 1000
- HIBÁTLAN iPhone 15 Pro 128GB Blue Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS4658, 90% AKKSI
- Lenovo ThinkPad T14s Gen 3 i5-1245U 14" FHD+ 16GB 1TB 1 év teljeskörű garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
