Telefonszámunk: 1-472-0679

[Resolved] VBA – adatok kigyűjtése külön munkalapra

Kezdőlap Fórumok Excel programozás [Resolved] VBA – adatok kigyűjtése külön munkalapra

Topic Resolution: Resolved
6 bejegyzés megtekintése - 1-6 / 6
  • Szerző
    Bejegyzés
  • #5578
    kovacsl1968
    Felhasználó

      Sziasztok!
      Előrebocsátom, barátkoznék én a makrózással, csak ő éppen nem nagyon szeretné ezt… Találtam ehhez hasonlót korábban, de ott tömbös adatokról volt szó… A következő problémám van. Adva van egy terjedelmes táblázat, mondjuk 6000 sor és kb 25 oszlop. Ami engem érdekelne mint feladat, az úgy néz ki, hogy a Q oszlopban nem mindig van adat. Azt szeretném, hogy amikor itt van adat, akkor az adott sor G és H oszlopaiból átmásolja az adatokat egy új munkalapra. Erre az új lapra készítettem egy két soros (fejléc + egy sor) és két oszlopos formázott táblázatot azért, hogy az átmásolt növekvő adatmennyiséget mindig táblázatként kezelje, ebből készíteném a kimutatást. Próbáltam a szűrési folyamatot makrózni, nem volt egy sikertörténet. Megpróbáltam manuálisan is alkotni valamit, de valamit biztos elszúrok, mert nem működik (röhögni nem ér):

      Sub tel()

      ‘ tel Makró


      Application.ScreenUpdating = False
      Sheets(„Telefonálók”).Select
      Range(„A2”).Select
      For i = 2 To 1000
      Munka6.Cells(i, 1).Value = „”
      Next i
      Sheets(„Garászmesteri jelentés”).Select
      Range(„Q5”).Select
      For i = 5 To 6000
      If Munka1.Cells(i, 17) = „” Then
      i = i + 1

      End If
      Next i
      If Munka1.Cells(i, 17) <> „” Then
      Munka1.Cells(i, 7).Select
      Selection.Copy
      Sheets(„Telefonálók”).Select
      Range(„A2”).Select
      For i = 2 To 1000
      If Munka6.Cells(i, 1) <> „” Then
      i = i + 1
      ‘Next i
      End If
      If Munka6.Cells(i, 1) = „” Then
      Selection.Paste
      ‘Next i
      End If

      Next i

      End If
      End Sub

      Előre is köszönöm ha valakinek van épkézláb ötlete…

      #5579
      delila
      Felhasználó

        A lap neve, ahonnan másolsz: „Eredeti”, ahova pedig: „Új munkalap”.

        Sub Masolas()
            Dim sor As Long, usor As Long, ide As Long
            
            Sheets("Eredeti").Select
            ide = 3
            usor = Sheets("Eredeti").Range("A" & Rows.Count).End(xlUp).Row
            For sor = 2 To usor
                If Cells(sor, "Q") > "" Then
                    Sheets("Új munkalap").Cells(ide, "A") = Cells(sor, "G")
                    Sheets("Új munkalap").Cells(ide, "B") = Cells(sor, "H")
                    ide = ide + 1
                End If
            Next
        End Sub
        #5583
        horvimi
        Adminisztrátor

          Ez teljesen jó, amit Delila írt.
          Én csak annyit tennék hozzá, hogy ezt meglátásom szerint egy sima irányított / speciális szűréssel meg lehet csinálni. Csak az a feltétel, hogy a Q oszlopban nincs semmi.

          Mivel mindig újra fut, és a teljes 6000+ táblát szűri, ezért a táblázat nem feltétlenül indokolt.
          Bár azt is meg lehet csinálni, hogy az eredmény lapon minden futás előtt törlöd a már ott lévő korábbi futás eredményét.

          #5588
          kovacsl1968
          Felhasználó

            Köszönöm a segítséget!

            #5607
            kovacsl1968
            Felhasználó

              Sziasztok!
              Nos próbáltam adaptálni a fenti makrót a sajátosságok figyelembe vételével sajnos nem történik semmi. Nem dob ki hibaüzenetet, de nem is csinál semmit.
              Így néz ki az én verzióm:

              >>>
              Sub Masolas()
              Dim sor As Long, usor As Long, i As Long

              Sheets(„Garázsmesteri jelentés”).Select
              i = 5
              usor = Sheets(„Garázsmesteri jelentés”).Range(„A” & Rows.Count).End(xlUp).Row
              For sor = 5 To usor
              If Cells(sor, „Q”) > „” Then
              Sheets(„Telefonálók”).Cells(i, „A”) = Cells(i, „G”)
              Sheets(„Telefonálók”).Cells(i, „B”) = Cells(i, „H”)
              i = i + 1
              End If
              Next
              End Sub
              <<<

              A „Garázsmesteri jelentésből” veszem az adatokat, az 5. sortól… Mit bénáztam már megint el? 🙁

              Köszi.

              #5608
              kovacsl1968
              Felhasználó

                Helyesbítek… Működik. 🙂 Persze, hogy bénáztam, de sikerült az adaptáció. Ezer köszi!

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