Hirdetés
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Google Pixel 9 Pro XL - hét szűk esztendő
- Milyen okostelefont vegyek?
- Samsung Galaxy A55 - új év, régi stratégia
- Samsung Galaxy Watch6 Classic - tekerd!
- Xiaomi Watch 2 Pro - oké, Google, itt vagyunk mi is
- Redmi Note 13 4G
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- Xiaomi 14T - nem baj, hogy nem Pro
-
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
- AliExpress tapasztalatok
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Milyen videókártyát?
- Óra topik
- Politika
- World of Tanks - MMO
- Lenovo Legion és IdeaPad Y széria
- exHWSW - Értünk mindenhez IS
- Szeged és környéke adok-veszek-beszélgetek
- Samsung Galaxy Felhasználók OFF topicja
- További aktív témák...
- Belèpő GAMER setup!! Kamatmentes rèszletre is!
- LG Velvet 128GB, Kártyafüggetlen, 1 Év Garanciával
- HPE Apollo 4200 Gen9 132TB+400GB rack szerver - E5-2620v4, 128GB RAM, 2x25G NET, 4GB RAID/ZFS, ÁFÁS
- DELL, HP gyári töltők, sok db. 7,4x5mm - 4,5x3mm + USB-C/Type-C 65W
- Csere-Beszámítás! RTX Számítógép játékra! I5 12400F / RTX 3070 ROG 8GB / 32GB DDR4 / 1TB Nvme SSD
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest