-
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
- Formula-1
- MasterDeeJay: RAM gondolatok: Mennyi a minimum? DDR3 is jó?
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- One otthoni szolgáltatások (TV, internet, telefon)
- Jófogás tapasztalatok
- Tőzsde és gazdaság
- Iqos cigaretta
- Milyen routert?
- Óvodások homokozója
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- További aktív témák...
- magyar billentyűzet - 151 - Lenovo LOQ (15IAX9) - Intel Core i5-12450HX, RTX 4060
- ÚJ-csak kipróbált Lenovo ThinkPad T14s Gen6 AI 7 Pro 350 PRO 64GB 1TB
- Telefon felvásárlás!! Samsung Galaxy A16, Samsung Galaxy A26, Samsung Galaxy A36, Samsung Galaxy A56
- GYÖNYÖRŰ iPhone XR 64GB Black -1 ÉV GARANCIA - Kártyafüggetlen, MS4270, 100% Akkumulátor
- HIBÁTLAN iPhone 14 Pro 256GB Gold- 1 ÉV GARANCIA - Kártyafüggetlen, MS4514
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50
