-
Fototrend
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
-
Delila_1
veterán
válasz
mr.nagy
#16294
üzenetére
Feltételezem, hogy az első a címsorod, a másodiktól kezdve vannak folyamatosan az adataid.
A lenti makró azt csinálja, amit kértél, plusz az AK oszlopba folyamatosan beírja a címsorban lévő üzlet nevét, ahol a plusz értéket átírta egy másik üzletbe (és ezt lenullázta), valamint azt, hogy mennyi volt ebben az üzletben és ebben a sorban az eredeti érték. Az AL oszlopba azt az üzletet írja, ahova át lett téve a plusz, az eredeti negatív értékkel és sorszámmal együtt.Pl. az Üzlet1-ben volt 5, az Üzlet5-ben -3, mindez a táblázatod 4. sorában, az AK oszlopban
Üzelet1 4.sor_5 db, az AL-ben Üzlet5 4.sor_-3 db lesz.Sub javaslat()
Dim oszlop As Integer, sor As Integer, usor, O1 As Integer, sorFelír
usor = Cells(Rows.Count, "A").End(xlUp).Row
sorFelír = 2
Range("AK:AL") = ""
Range("AK1") = "Honnan–eredeti érték": Range("AL1") = "Hova–eredeti érték"
For sor = 2 To usor
For oszlop = 14 To 32
If Cells(sor, oszlop) > 0 Then
For O1 = oszlop + 1 To 33
If Cells(sor, O1) < 0 Then
Cells(sorFelír, "AK") = Cells(1, oszlop) & " " & sor & ".sor_" & Cells(sor, oszlop) & " db"
Cells(sorFelír, "AL") = Cells(1, O1) & " " & sor & ".sor_" & Cells(sor, O1) & " db"
Cells(sor, O1) = Cells(sor, O1) + Cells(sor, oszlop)
Cells(sor, oszlop) = 0
sorFelír = sorFelír + 1
Exit For
End If
Next
End If
Next
Next
End Sub
Új hozzászólás Aktív témák
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- The Elder Scrolls Online Imperial Collector s Edition
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- White GAMER PC! Ryzen 7800X3D / RTX 4080 / 32GB DDR5 / 1TB NVMe / 1000w Gold / BeszámítOK !
- ÁRGARANCIA!Épített KomPhone i5 10400F 16/32/64GB RAM RX 7600 8GB GAMER PC termékbeszámítással
- GYÖNYÖRŰ iPhone XR 128GB White-1 ÉV GARANCIA - Kártyafüggetlen, MS4294
- Bomba ár! Lenovo ThinkPad T14 G2i - i5-11G I 16GB I 512GB SSD I 14" FHD I Cam I W11 I Garancia!
- 27% - ASUS TUF Gaming VG28UQL1A Monitor! 3840x2160 / 1ms / 144Hz / G-Sync / FreeSync BeszámítOK!
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50