Hirdetés
- Yettel topik
- OneSport OT07 - szevasztok, hollandok!
- Poco X6 Pro - ötös alá
- MWC 2025: A kicsi és a kamerás - megjött a Xiaomi 15 és az Ultra
- Szívós, szép és kitartó az új OnePlus óra
- Milyen okostelefont vegyek?
- Samsung Galaxy A54 - türelemjáték
- Google Pixel topik
- Samsung Galaxy S24 FE - később
- Apple iPhone 16 - ígéretek földje
-
Mobilarena
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
-
Fferi50
Topikgazda
válasz
b3n1t0 #32226 üzenetére
Szia!
A következő makró egy új munkalapra kibontja a sorokat, úgy hogy minden új sor után tesz egy üres sort, illetve a legelső sorba beírja az eredeti értékeket - ezt a sort el tudod hagyni, ha kitörlöd, nem okoz semmi problémát, megjegyzésben mellé írtam.
Sub kibonto()
Dim rngalap As Range, rngdatum As Range, wsh1 As Worksheet, wsh2 As Worksheet, xx As Integer, sor As Range, cl As Range
Set wsh1 = ActiveSheet
Set rngalap = Intersect(wsh1.UsedRange, wsh1.UsedRange.Parent.Columns("K:AH"))
Set wsh2 = Worksheets.Add(after:=Sheets(ActiveSheet.Name))
xx = 1
For Each sor In rngalap.Rows
sor.Copy Destination:=wsh2.Cells(xx, "K") ' ez az eredeti értéket tartalmazza, ha nincs rá szükséged akkor kitörölheted a következő sorral együtt
xx = xx + 1
Set rngdatum = wsh1.Range("AJ" & sor.Row & ":AQ" & sor.Row)
For Each cl In rngdatum.Cells
If IsEmpty(cl) Then Exit For
wsh2.Cells(xx, "K").Value = sor.Cells(1) + cl.Value
Range(wsh2.Cells(xx, "L"), wsh2.Cells(xx, "O")).Value = Range(sor.Cells(2), sor.Cells(5)).Value
Range(wsh2.Cells(xx, "P"), wsh2.Cells(xx, "AH")).Formula = "=int(" & sor.Cells(6).Address(external:=True, columnabsolute:=False) & "*" & cl.Offset(0, 8).Address(external:=True, rowabsolute:=True, columnabsolute:=True) & "/ 100)"
Range(wsh2.Cells(xx, "P"), wsh2.Cells(xx, "AH")).Value = Range(wsh2.Cells(xx, "P"), wsh2.Cells(xx, "AH")).Value
xx = xx + 1
Next
xx = xx + 1
Next
End SubÜdv.
Új hozzászólás Aktív témák
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- FIGYELEM - Megjelent az Office 2024 - Bevezető áron
- Játékkulcs BAZÁR! STEAM/ORIGIN/BATTLE.NET/PS5/XBOX/EPIC/GOG/EA/UPLAY
- iPad 10 eredeti Apple cover (Smart Folio)
- Intel X540-T2 dual-port 10GbE RJ45 hálózati vezérlő (10Gbit, 2 port, áfás számla, garancia)
- LG 48C2 - 48" OLED EVO - 4K 120Hz 1ms - NVIDIA G-Sync - FreeSync Premium - HDMI 2.1 - A9 Gen5 CPU
- 12 részletre elérhető Acer Predator Helios 18
- Telefon Felvásárlás!! iPhone 14/iPhone 14 Plus/iPhone 14 Pro/iPhone 14 Pro Max
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest