Telefonszámunk: 1-472-0679

[Resolved] Kimutatások automatikus elkészítése

Kezdőlap Fórumok Excel programozás [Resolved] Kimutatások automatikus elkészítése

Topic Resolution: Resolved
7 bejegyzés megtekintése - 1-7 / 7
  • Szerző
    Bejegyzés
  • #10571
    Adri0324
    Felhasználó

      Sziasztok!

      A következő feladatot nem sikerült megoldanom:
      A csatolt fájlban látható, hogy egy munkalapra több táblázat van beszúrva. Előre nem tudjuk hány táblázat lesz és mekkora méretű, de nagyjából így fog kinézni. Az lenne a feladat, hogy azokhoz a táblázatokhoz, amik a sarokban K-val meg vannak jelölve, készüljön kimutatás pontosan a táblázattal egy vonalba, két oszloppal jobbra. Az első táblázathoz megcsináltam a kimutatást, minden megjelölt táblázat mellé ilyesmit kell készíteni. (Mindegy milyen mezőkkel, azok utólag egyedileg lesznek beállítva) Egyébként ezek a táblázatok „mozgásban” lesznek. Egyesek majd törlésre kerülnek, időnként pedig újak készülnek. A táblázatok nevét nem tudjuk előre és azt sem, hány táblázat lesz.
      A makró feladata az lenne, hogy keresse meg a táblázatokat, és ha az meg van jelölve K-val ÉS! még nincs mellette kimutatás, akkor készítse el a megfelelő helyre.
      Remélem érthető. Nem tudom hogy fogjak hozzá.
      A csatolt fájl már tartalmaz egy makrót, ami frissíti a kimutatásokat, ha a táblázatok tartalma megváltozik. Természetesen az adatok nem valósak.

      Nagyon köszönöm, ha valaki tud ebben segíteni.

      Attachments:
      You must be logged in to view attached files.
      #10574
      verax
      Felhasználó

        Szia Adri!

        „…keresse meg a táblázatokat, és ha az meg van jelölve K-val…’
        Van olyan „K”, ami nem valamelyik táblazatot jelöli meg? Ugye nincs. Akkor nem a táblázatokat kell megkeresni, hanem a „K”-kat.

        „…ÉS! még nincs mellette kimutatás,…”
        1. Keresd a „K”-kat! (Használj valamilyen ciklust!)
        2. Tárold el a találat sorát!
        3. Keresd a kimutatásokat! (Használj az előző ciklusba ágyazott For Each ciklust!)
        4. Állapítsd meg és tárold el a Kimutatás által elfoglalt tartomány címét!
        5. Állapítsd meg hogy az eltárolt sor és „L” oszlop által hivatkozott cella része-e a kimutatás területének!
        6. Az így megkapott logikai érték alapján meghozhatod végre a döntést: Hozz / Ne hozz létre egy kimutatást!

        üdvözlettel
        verax

        #10575
        horvimi
        Adminisztrátor

          Csatlakoznék Verax-hoz némi részlettel.
          Én is a K-kat keresném. A K pozíciójához képest mindig ugyanannyi offset-tel kell lennie vagy nem lennie a kimutatásnak.
          A PIVOT létezését én úgy szoktam megállapítani, hogy lekérdezem valamelyik tulajdonságát, és ha hibát ad, akkor nincs ott PIVOT.

          Próbáld ezt ki:
          1. belekattintasz egy létező PIVOT-ba és az Immediate ablakba beírod:
          ?Activecell.PivotTable.Name
          2. Válassz egy PIVOT-on kívüli cellát és ismételd meg a parancsot, hibát fogsz kapni nyilván.

          Menjünk közelebb.
          1. Kattints az egyik K-ra, ahol van pivot a tábla mellett
          2. Az előző parancsot offset-tel add ki
          ?Activecell.offset(sor, oszlop).pivottable.name
          3. Ha nincs ott Pivot, akkor hibát fogsz kapni.

          Tehát a Pivot létezésének megállapítását klasszik on error resume next módszerrel meg lehet csinálni.

          Ezután térhetsz rá a pivot legyártására.

          Imre

          #10576
          verax
          Felhasználó

            Sziasztok! Szia Adri!

            Köszönöm Imre! Nekem tetszik a megközelítésed. Nem keresgélünk kimutatást a munkalapon, hanem célirányosan odamegyünk, ahol lennie kellene.
            Apró kiegészítés: Lehet, hogy a leegyszerűsített példa miatt kerülte el a figyelmemet, hogy vizsgáljam az „K”-val jelölt táblázatok szélességi méretét. Adri leírásában ott van:
            „…nem tudjuk hány táblázat lesz és mekkora méretű,…” továbbá: „…készüljön kimutatás pontosan a táblázattal egy vonalba, két oszloppal jobbra.”
            Ezek miatt mégis vizsgálni kell a táblázatokat is. Kicsit összetettebb a megoldás de nem reménytelen.

            1. Keresed meg a „K”-t!
            2. Határozd meg a hozzá tartozó táblázatot! Imre által javasolt, a kimutatás tábla nevére való rákérdezéshez hasonló módon. A táblázatok ListObject típusú objektumok.
            3. Állapítsd meg a táblázat szélességét! Ezt az értéket használd a „K”-kat tartalmazó cellákhoz viszonyítottan eltolt kimutatások létezésének vizsgálatához – ahogyan Imre mutatta!

            Az On Error Resume Next is hasznos. Én egy String típusú változónak adom át a kimutatás tábla nevére való rákérdezés eredményét. Ezt az eredményt vizsgálom tovább egy Select Case elágazásban. Létező kimutatás tábla esetén (Err.Number=0) a Case 0, nem létező esetén (Err.Number=1004) a Case 1004 irányt választom. Nyilván ez utóbbiban kell a kimutatás tábla elkészítéséről gondoskodni.

            üdv’
            verax

            #10577
            horvimi
            Adminisztrátor

              Egy ilyen „egyszerűbb” esetben abból szoktam kiindulni, hogy ha hiba adódik, akkor az csak az lehet, hogy nincs ott pivot tábla. Ezért egyszerűen a
              if Err.Number<>0
              irányt választom.

              A K alatti táblázatok méretének megállapításához:
              Ha mindegyik táblázattá (listobject) van alakítva (amit javaslok), akkor van a legegyszerűbb dolgunk, mert akkor az előbbiekhez hasonlóan a
              Activecell.Offset(1,0).ListObject.Name
              megmondja a nevét, ami a legyártandó pivot adatforrása lehet.

              Ha nincs táblázattá alakítva, akkor a K alatti cellától indulva kell bűvészkedi. A bonyolultság attól függ, hogy minden sora és oszlopa ki van-e töltve (legyen!!!)
              Ebben az esetben a kezdőcella a K alatti cella, a vége pedig a lefelé majd jobbra irányított End-ekkel megállapítható:
              Activecell.Offset(1,0).End(xlDown).End(xlToRight)

              Imre

              #10578
              Adri0324
              Felhasználó

                Kedveseim! Nagyon köszönöm!

                Képzeljétek, megoldottam. 3 napom ment rá. (Tudom, jó béna vagyok)
                Kicsit csentem innen, kicsit kérdeztem onnan… De megoldottam.
                Mondtam is a főnöknek, elmentem pezsgőt bontani… 🙂
                Íme a művem:

                Private Sub Worksheet_Change(ByVal Target As Range)
                    Dim ws As Worksheet
                    Dim tbl As ListObject
                    Dim pivotDestRange As Range
                    Dim pivotCache As pivotCache
                    Dim pivotTable As pivotTable
                    Dim lastColumn As Long
                    Dim i As Integer
                    Dim foundK As Boolean
                    Dim cell As Range
                    
                     If Me.Name = "Munka1" Then
                        If UCase(Left(Target.Cells(1, 1).Value, 1)) = "K" Then
                          Set ws = ThisWorkbook.Sheets("Munka1")
                            For Each tbl In ws.ListObjects
                                If UCase(Left(tbl.HeaderRowRange.Cells(1, 1).Value, 1)) = "K" Then
                                  Set pivotDestRange = tbl.Range.Cells(1, tbl.Range.Columns.Count + 2)
                                    On Error Resume Next
                                    If pivotDestRange.pivotTable Is Nothing Then
                                        Set pivotCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbl.Range)
                                        Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=pivotDestRange, TableName:="Kimutatas")
                                        If i = 0 Then
                                            pivotTable.Name = "Kimutatas_" & tbl.Name
                                            i = 1
                                        Else
                                            pivotTable.Name = "Kimutatas_" & tbl.Name & "_" & i
                                        End If
                                        pivotTable.TableStyle2 = "Boss1"
                                       pivotTable.TableRange2.Select
                                        pivotTable.PivotFields(2).Orientation = xlDataField
                                    End If
                                    On Error GoTo 0
                                End If
                            Next tbl
                        End If
                    End If
                    
                    If Not Intersect(Target, Me.UsedRange) Is Nothing Then
                        Application.EnableEvents = False
                        ActiveWorkbook.RefreshAll
                        Application.EnableEvents = True
                    End If
                End Sub

                Azért csatolom a fájlt is, amiben működik.
                A kimutatás formázásával még küzdök, de már alakul.

                Attachments:
                You must be logged in to view attached files.
                #10580
                horvimi
                Adminisztrátor

                  Szuper, ügyes vagy!
                  Örülünk 🙂

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