Telefonszámunk: 1-472-0679

[Resolved] VBA – Összegzés tömb segítségével

Kezdőlap Fórumok Excel programozás [Resolved] VBA – Összegzés tömb segítségével

Topic Resolution: Resolved

Ennek a témakörnek tartalma 5 hozzászólás, 2 résztvevő. Utolsó frissítés:  delila 2 hete, 3 napja telt el.

6 bejegyzés megtekintése - 1-6 / 6
  • Szerző
    Bejegyzés
  • #7120

    pexcel
    Felhasználó

    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).Column

    For j = 2 To lCol
    For i = 2 To lRow – 1

    On 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 = Xsum

    Next i
    Next j

    End 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éter

    Attachments:
    You must be logged in to view attached files.
    #7122

    delila
    Felhasználó

    Szia!

    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

    #7123

    pexcel
    Felhasználó

    Szia 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

    #7125

    delila
    Felhasználó

    Szí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.

    #7126

    pexcel
    Felhasználó

    Igen, é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éter

    #7127

    delila
    Felhasználó

    Örülök, hogy sikerült segítenem.

6 bejegyzés megtekintése - 1-6 / 6

Be kell jelentkezni a hozzászóláshoz.