Hirdetés
- 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
- 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
-
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
- Ukrajnai háború
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: MárkaLánc
- nVidia GeForce GTX 1070 / 1070 Ti / 1080 (GP104)
- Békéscsaba és környéke adok-veszek-beszélgetek
- ASUS routerek
- Meggyi001: Vegán? Nem vegán?
- Samsung Galaxy A55 - új év, régi stratégia
- További aktív témák...
- Bomba ár!! Lenovo E31-80 - i5-6GEN I 8GB I 256GB SSD I 13,3" I HDMI I Cam I Win10 I Garancia!
- Lenovo ThinkPad dokkolók: USB-C 40A9/ 40AY/ 40AS/ Thunderbolt 3 40AC/ Hybrid USB-C DisplayLink 40AF
- Huawei P20 Lite 64GB, Kártyafüggetlen, 1 Év Garanciával
- Xiaomi Redmi Note 13 256GB, Kártyafüggetlen, 1 Év Garanciával
- Csere-Beszámítás! RTX Számítógép játékra! I5 7500 / RTX 2060 6GB / 32GB DDR4 / 500GB SSD
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest