Kezdőlap › Fórumok › Excel programozás › [Resolved] VBA – Összegzés tömb segítségével
- This topic has 5 hozzászólás, 2 résztvevő, and was last updated 4 years, 4 months telt el by delila.
-
SzerzőBejegyzés
-
2020-05-14-20:18 #7120
Sziasztok,
Ismét egy VBA-val kapcsolatos kérdésben szeretném a segítségeteket kérni.
Adott egy több oszlopból álló táblázat, amely különböző termékek árainak napi idősorait tartalmazza (ebből egy kivonatot mintaként csatoltam).
Az egyes termékek napi árváltozásainak (egyszerű különbségeinek) abszolút értékeit szeretném kigyűjteni egy tömbbe, ezeket összegezni, majd ezt az összeget megjeleníti az egyes oszlopok végén.
Az alábbi rutin lefut, azonban így a tömb tartalma folyamatosan „hízik”.Sub tomb_kigyujt()
Dim i, j As Long
ReDim Arraytest(0)lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).ColumnFor j = 2 To lCol
For i = 2 To lRow – 1On Error Resume Next
Arraytest(UBound(Arraytest)) = Abs(Cells(i + 1, j) – Cells(i, j))
ReDim Preserve Arraytest(UBound(Arraytest) + 1)Xsum = WorksheetFunction.Sum(Arraytest)
Cells(lRow + 2, j).Value = XsumNext i
Next jEnd Sub
A kérdésem az lenne, hogy van-e lehetőség arra, hogy mielőtt a rutin belép a következő ciklusba, a tömb korábbi tartalmát töröljük, azaz mindig csak az aktuális oszlop differenciáinak abszolút értékeit összegezzük. (Az ’Erase’ parancsot próbáltam, de az mindent töröl, így az eredmények nullák lesznek).
Segítségeteket előre is köszönöm!
PéterAttachments:
You must be logged in to view attached files.2020-05-15-07:28 #7122Szia!
Erre gondolsz?
Sub tomb_kigyujt() Dim i As Long, j As Long, lRow As Long, lCol As Long, Xsum As Single ReDim Arraytest(0) lRow = Cells(Rows.Count, 1).End(xlUp).Row lCol = Cells(1, Columns.Count).End(xlToLeft).Column For j = 2 To lCol For i = 2 To lRow - 1 On Error Resume Next 'Ez minek? Arraytest(UBound(Arraytest)) = Abs(Cells(i + 1, j) - Cells(i, j)) ReDim Preserve Arraytest(UBound(Arraytest) + 1) Xsum = WorksheetFunction.Sum(Arraytest) Cells(lRow + 2, j).Value = Xsum Next i ReDim Arraytest(0) Next j End Sub
üdv, Kati
2020-05-15-08:55 #7123Szia Kati,
Igen erre, nagyon szépen köszönöm a gyors segítséget!
Az On Error Resume Next-et azért tettem bele, mert az adatok automatikusan generálódnak SQL query-ből, ugyanakkor van több olyan termék, ahol nincs adat. Ezeknél árak helyett egy szöveges kód jelenik meg.
De valószínű, hogy enélkül is megy, mivel a Sum függvény a szöveget figyelmen kívül hagyja.Még egyszer nagyon köszönöm!
Péter
2020-05-15-09:14 #7125Szívesen.
Figyelted, hogy a változók deklarálását kiegészítettem? Egyrészt nem szerepelt mindegyik a Dim sorban, másrészt a
Dim i, j As Long
sor az i változónak variantként foglal helyet a memóriában, aminek nagyobb a helyszükséglete, mint a Long-é. Mindegyiknél külön meg kell határozni a típust.
Érdemes a VBE-ben megadni, hogy tegye kötelezővé a változók deklarálását. A Tools | Option | Editor fülön jelöld be a Require Variable Declaration opciót. Ennek hatására minden újonnan megnyitott mudul tetején megjelenik az Option Explicit szöveg. Ha a modulban le nem foglalt változót használsz, a makró az indításakor jelez, és megáll. Így elkerülhető, hogy egy elírt karakter hatására fals eredményt kapj, aminek az okát keresgélheted.Például a makródban van két sor:
Xsum = WorksheetFunction.Sum(Arraytest) Cells(lRow + 2, j).Value = Xsum
Ha a 2. sorban véletlenül Xszum-ot íratsz be a megadott helyre, csodálkozhatsz, hogy minden esetben 0 értéket kapsz.
2020-05-15-09:51 #7126Igen, észrevettem, hogy a deklarációk bővültek.
Ugyanakkor nagyon köszönöm a mögöttes kiegészítést és magyarázatot, nagyon hasznos volt.
Az általad javasolt beállítást meg is tettem a Tools | Option | Editor fülön.Köszönöm,
Péter2020-05-15-09:52 #7127Örülök, hogy sikerült segítenem.
-
SzerzőBejegyzés
- Be kell jelentkezni a hozzászóláshoz.