Telefonszámunk: 1-472-0679

Hozzászólások

15 bejegyzés megtekintése - 1-15 / 15
  • Szerző
    Bejegyzés
  • 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.
      Adri0324
      Felhasználó

        Sziasztok.
        Megoldottam. Bár 3 napom ráment. Ide teszem a kész kódot, ha valakit érdekel. Csatolom az Excelt is…
        Köszönöm a segítséget.

        Sub Masolas()
            Dim Munka2 As Worksheet
            Dim Munka1 As Worksheet
            Dim Szint2 As ListObject
            Dim Szint1 As ListObject
            Dim Tbl12 As ListObject
            Dim FirstRowTbl12 As Long
            Dim LastRowTbl12 As Long
            Dim osszegSor As Long
            
            Set Munka2 = ThisWorkbook.Sheets("Munka2")
            Set Szint2 = Munka2.ListObjects("Szint_2")
            
            Set Munka1 = ThisWorkbook.Sheets("Munka1")
            Set Szint1 = Munka1.ListObjects("Szint_1")
            
            Set Feladat = ThisWorkbook.Sheets("Feladat")
            Set Tbl12 = Feladat.ListObjects("Táblázat12")
            
             Feladat.ListObjects("Táblázat12").ShowTotals = False
            
            For i = Tbl12.ListRows.Count To 2 Step -1
                Tbl12.ListRows(i).Delete
            Next i
            Szint2.ListColumns("Érték ID").DataBodyRange.Value = Szint2.ListColumns("Ssz").DataBodyRange.Value
            Szint1.ListColumns("Érték ID").DataBodyRange.Value = Szint1.ListColumns("Ssz").DataBodyRange.Value
        
            FirstRowTbl12 = 1
            Tbl12.ListColumns("Érték ID").DataBodyRange.ClearContents
            
            Tbl12.ListColumns("Érték ID").DataBodyRange.Cells(FirstRowTbl12, 1).Resize(Szint1.ListColumns("Érték ID").DataBodyRange.Rows.Count, 1).Value = Szint1.ListColumns("Érték ID").DataBodyRange.Value
            
            LastRowTbl12 = FirstRowTbl12 + Szint1.ListColumns("Érték ID").DataBodyRange.Rows.Count
            Tbl12.ListColumns("Érték ID").DataBodyRange.Cells(LastRowTbl12, 1).Resize(Szint2.ListColumns("Érték ID").DataBodyRange.Rows.Count, 1).Value = Szint2.ListColumns("Érték ID").DataBodyRange.Value
            
            LastRowTbl12 = Tbl12.ListRows.Count
            Set ertekIDOszlop = Tbl12.ListColumns("Érték ID")
            LastRowTbl1 = Szint1.ListRows.Count
            LastRowTbl2 = Szint2.ListRows.Count
            
            osszegSor = Application.WorksheetFunction.Max(Szint1.ListRows(LastRowTbl1).Range, Szint2.ListRows(LastRowTbl2).Range)
            
            Tbl12.Resize Tbl12.HeaderRowRange.Resize(osszegSor + 1)
             
             Feladat.ListObjects("Táblázat12").ShowTotals = True
               
        End Sub
        Attachments:
        You must be logged in to view attached files.
        Adri0324
        Felhasználó

          Kedves Delila!

          Köszönöm, de sajnos nem jó. Hiba ugyan nincs benne, de nem úgy működik, amire szükségem van. A táblázatok függvényeket tartalmaznak, ezért kéne csak az Érték ID oszlopot mozgatni. A megoldás amit küldtél, a Táblázat12-t teljesen felülírta, ráadásul csak az egyik táblázat adatai kerülnek bele, a második táblázat adatai a cél helyen, de a táblázaton kívülre kerülnek. Meglepő módon viszont a cél táblázat mérete a második forrás táblázat méretével nőtt meg. Szóval itt legalább átméretezi a táblázatomat, csak nem jól és nem jó helyen.

          Adri0324
          Felhasználó

            Szia,
            rendben, köszönöm. Legközelebb így járok el.
            Most csatoltan küldöm ennek a feladatnak a Excelét, fals adatokkal, én is ezekkel dolgoztam.

            Attachments:
            You must be logged in to view attached files.
            Hozzászólás: [Resolved] Keresés legördülő listában #10500
            Adri0324
            Felhasználó

              Szia.
              Ez a megoldás hibátlan, köszönöm szépen.
              Nálam sokkal hozzáértőbb is zseniálisnak nevezte. 🙂 Úgyhogy tényleg köszi még egyszer.

              Hozzászólás: [Resolved] Keresés legördülő listában #10498
              Adri0324
              Felhasználó

                Nagyon köszönöm a segítséget.
                Az akárhány többszintű megoldásodhoz is tettem fel egy kérdést, ha lenne rá egy kis időd, gondolkodnál rajta légyszi? 🙂
                Köszönöm.

                Hozzászólás: [Resolved] Keresés legördülő listában #10494
                Adri0324
                Felhasználó

                  Szia!

                  Office 365 Business Edition használunk. Megnéztem és naprakész, minden frissítés le van töltve, de sajnos nem keres, csak kezdőbetűtől.
                  Ez lehet esetleg beállítási probléma?
                  Köszönöm a segítséget.

                  Hozzászólás: Évényesítések frissítése #10382
                  Adri0324
                  Felhasználó

                    Köszi szépen a segítséget mindenkinek. Ezt akkor elengedtük, lesz más megoldás. Vannak dolgok amik nem rajtam múlnak. 😉
                    Nagyon köszönöm mindkettőtöknek.

                    Adri0324
                    Felhasználó

                      Kedves Verax,

                      nem tudok elég hálás lenni a sok segítségért.
                      Úgy tűnik elkészült ez a feladat is. Sikerült úgy átalakítanom, hogy egy makró leköveti a nyers export minden változását és hozzá alakítja a többi munkafüzetet.
                      Akár több adatról akár kevesebbről van szó, szépen beszúrja és törli a sorokat, másolja a cellákat. Még sokszor fogom elemezni amit küldtél, igyekszem tanulni belőle. 🙂

                      Még egyszer nagyon köszönöm

                      Üdv

                      Adri

                      Adri0324
                      Felhasználó

                        Kedves Verax!

                        Szuper, nagyon köszönöm. Majdnem tökéletes, de az érték oszlopot azért kell beszúrni, hogy a soreltérés végül 0 legyen (Miután lefutott a makró.) De ezt már meg is oldottam, köszönöm. Kicsit átalakítottam ezt-azt, így már majdnem tökéletes….
                        Még egy feladat merült fel ezzel kapcsolatban… Azt hogy tudom megoldani, hogy utolsó lépésként ha az állapot fülben az ID (Érték) oszlopban talál 0-át, azt az egész sort törölje. Tehát, ha a makró lefut, de közben nem több lett a sor a nyers exportban hanem kevesebb, akkor az üres sorokat törölje az állapot fülből.

                        Üdv!

                        Adri

                        Adri0324
                        Felhasználó

                          Kedves Verax!
                          Mutatom a konkrét feladatot…. a csatolt táblázatban a nyers export fülbe kerülnek a programunkból kinyert adatok, ez állandóan változó hosszúságú táblázat lesz.
                          A soreltérés fülben az ID export oszlopba bekerülnek az azonosítók. Pontosan annyi, ahány sora van a nyers exportnak.
                          Az állapot fülbe szintén bekerülnek a nyers exportban lévő azonosítók. Majd az állapot fülben az ID oszlopok értékét átmásoljuk az ID érték oszlopba, mely adatok vissza kerülnek a soreltérés fül ID Állapot oszlopába. Az lenne a makró feladata, hogy a soreltérés fülön megvizsgálja a hiány oszlop végösszegét, majd az állapot fül táblázatának a végére beszúrjon annyi sort, amilyen értéket ott talált, ezután pedig az állapot oszlopból az összes értéket beillessze az ID Érték oszlopba. (tehát a képletet ne). Az lenne a legjobb, ha a makró akkor futna le, ha a soreltérés fül hiány oszlopának végösszege nagyobb, mint nulla. Remélem érthető voltam…:) Ha ez nem kivitelezhető, akkor az is jó lenne, ha minden mentéskor lefutna. Csak rövid ideje próbálkozom a makrózással, ezt még nem tudom megoldani sajnos. Nagyon megköszönném, ha segítenél.

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

                            Kedves verax!

                            Segítenél még egy makró kérdésben?

                            Azt szeretném, ha a makró egy adott tábla végére beszúrna sorokat (eddig megy nekem is), de úgy, hogy egy cellában lévő szám legyen a beszúrt sorok száma. Ez a szám változni fog, a makró mindig annyit kell beszúrjon, amilyen szám van az adott cellában. ű
                            Mitől tud lefutni a makró? Az megoldható, hogy a mentéskor lefusson? Vagy ha az adott cella értéke nagyobb mint „0”? Ezt tudja folyamatosan figyelni? De ha nem, akkor jó úgy is, ha mentéskor fut le.

                            Nagyon köszönöm, ha segítesz.

                            Adri0324
                            Felhasználó

                              Kedves verax!

                              Megírtad helyettem a makrót! 🙂 Nagyon köszi. 😀 Így lehet haladni a munkával. 😀

                              Még egyszer köszönöm a sok segítséget.

                              Adri0324
                              Felhasználó

                                Sziasztok!

                                eNFeri és verax! nagyon köszönöm!
                                A kettőtök válasza együtt a tökéletes megoldás.
                                eNFeri köszi, így már meg tudjuk számolni a sortöréseket, és verax köszi, így el tudjuk távolítani a többi karaktert.
                                Szóval a kettő együtt működik. Még egyszer köszi. 🙂

                                Üdv! Adri

                                Adri0324
                                Felhasználó

                                  Szia.

                                  Köszi szépen, ez nagyon jó, valószínűleg meg is oldja a problémánkat, de a csere azon a módon nem működik, ahogy írtad. Ha beírjuk a karaktereket „|” karakterrel ahogy a példában írtad, hibaüzenetet küld. Egyesével megcsinálta, működik is. de ez nem sikerül, hogy az összes karaktert cseréljük. Erre van ötleted? Azt írja, hogy nem található cserélendő adat. Néha pedig azt, hogy nem találjuk amit keres.
                                  Köszönöm a segítséget.

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