Hirdetés
- OneSport OT07 - szevasztok, hollandok!
- iPhone topik
- MWC 2025: A kicsi és a kamerás - megjött a Xiaomi 15 és az Ultra
- Honor Magic7 Pro - kifinomult, költséges képalkotás
- Mobil flották
- Bemutatkozott a Poco X7 és X7 Pro
- Samsung Galaxy S23 Ultra - non plus ultra
- One mobilszolgáltatások
- Milyen okostelefont vegyek?
- Samsung Galaxy A70 - áram, erősség
-
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
- Forza sorozat (Horizon/Motorsport)
- Drón topik
- Luck Dragon: MárkaLánc
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- Vicces képek
- OneSport OT07 - szevasztok, hollandok!
- One otthoni szolgáltatások (TV, internet, telefon)
- Veszprém és környéke adok-veszek-beszélgetek
- További aktív témák...
- LG 45GR65DC-B - 45" Ívelt 1500R / 5120x1440 / 200Hz 1ms / Adaptive Sync / AMD FreeSync / HDR 600
- Bomba ár! Lenovo ThinkPad X13 G1- i5-10310U I 16GB I 256SSD I 13,3" FHD I Cam I W10 I Gari!
- Dell D6000 univerzális dokkoló USB-C/ USB-A, DisplayLink & Dell WD15 (K17A) USB-C + 130-180W töltő
- LG 45GR95QE - 45" Ívelt OLED / 2K WQHD / 240Hz 0.03ms / NVIDIA G-Sync / FreeSync Premium / HDMI 2.1
- Bomba ár! Lenovo Miix 720-12IKB : i7-7G I 16GB I 256GB SSD I 12" Touch I Cam I W10 I Garancia!
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest