2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    PROHARDVER!

    A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
    Kérdés felvetése előtt olvasd el, ha még nem tetted.

Új hozzászólás Aktív témák

  • #38484 föccer nagyúr
    Új Válasz #38484
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    föccer

    nagyúr

    Sziasztok!

    Makro segítséget kérek.

    Van egy táblázatom, amibe autoszűrűvel beállítom a szükséges paramétereket.

    A Mintavételek fülön van, az autoszűrő a 6 sorban van beállítva, az adattábla ez alatti sorokban

    Munka1 segédtáblázatra kellene kitennem az szűrt táblázat E oszlopából a leszűrt elemeket, a Munka 1 A1 cellájától kezdődően, majd B1-be beszúrva eltávolítom az ismétlődéseket, majd az egyedi értékeket átmásolnám a J oszlopba.

    A többi lépés majd ez után jön. A problám az, hogy a kód nem illeszti be az összes szűrt elemet a mintavétel munkalapról, csak a legelsőt.

    Hol a hiba?

    Köszi :R

    Sub Szilardsagi_elemzes_masolas()

    Dim i, j, sor, k As Integer


    '---------------------------------------- Előzmények törlése

    Sheets("Munka1").Select
    activesheets.Columns("A:A").Select
    Selection.ClearContents
    activesheets.Columns("B:B").Select
    Selection.ClearContents
    activesheets.Columns("J:J").Select
    Selection.ClearContents
    For k = 1 To 150
    Sheets("Munka1").Range("K" & k).Formula = "=COUNTIFS(C[-10],RC[-1])"
    End


    '---------------------------------------- receptszámok átmásolása, válogatása

    Sheets("Mintavételek").Select
    For sor = 7 To 100000
    If Rows(sor).Hidden = False Then
    Range("E" & sor).Select
    Range(Selection, Selection.End(x1Down)).Select
    Selection.Copy
    End If
    End
    Sheets("Munka1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Sheets("Munka1").Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

    ActiveSheet.Range("$B$1:$B$1000").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("J1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Új hozzászólás Aktív témák