Hirdetés
- Milyen okostelefont vegyek?
- Samsung Galaxy A54 - türelemjáték
- Google Pixel topik
- Poco X6 Pro - ötös alá
- Samsung Galaxy S24 FE - később
- Apple iPhone 16 - ígéretek földje
- OneSport OT07 - szevasztok, hollandok!
- Szívós, szép és kitartó az új OnePlus óra
- iPhone topik
- Samsung Galaxy S25 - végre van kicsi!
-
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
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
- Honor 90 Lite 256GB, Kártyafüggetlen, 1 Év Garanciával
- Telefon felvásárlás!! Apple Watch Series 6/Apple Watch Series 7/Apple Watch Series 8
- Intel X540-T2 dual-port 10GbE RJ45 hálózati vezérlő (10Gbit, 2 port, áfás számla, garancia)
- MacBook, Apple M1 / M2 kompatibilis dokkolók, DisplayLink 4K, USB-C, Type-C
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest