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
6 bejegyzés megtekintése - 1-6 / 6
  • Szerző
    Bejegyzés
  • 2020-05-14-20:18 #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.
      2020-05-15-07:28 #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

        2020-05-15-08:55 #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

          2020-05-15-09:14 #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.

            2020-05-15-09:51 #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

              2020-05-15-09:52 #7127
              delila
              Felhasználó

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

              • Szerző
                Bejegyzés
              6 bejegyzés megtekintése - 1-6 / 6
              • Be kell jelentkezni a hozzászóláshoz.