Hirdetés
-
PROHARDVER!
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
- iPhone 12 Pro 256GB Gold -1 ÉV GARANCIA - Kártyafüggetlen, MS3581, 100% Akksi
- HP 150W töltők (19.5V 7.7A) kis kék, kerek, 4.5x3.0mm
- GYÖNYÖRŰ iPhone 11 64GB Red -1 ÉV GARANCIA - Kártyafüggetlen, MS2190, 100% Akkumulátor
- Gamer PC-Számítógép! Csere-Beszámítás! I3 14100F / RTX 3060Ti / 16GB DDR5 / 1TB SSD
- Samsung UE75DU7172U 189 cm / 75 4K UHD Smart TV 6 hó garancia Házhozszállítás
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50

