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

    LOGOUT

    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

  • #28660 szőröscica addikt
    Új Válasz #28660
    Ú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

    szőröscica

    addikt

    Sziasztok!

    Van egy makróm, amit arra használok, hogy egy mappában szereplő összes xls tartalmát behúzza egyetlen sheetre. Először egy másik makróval kilistáztatom az összes fájlt ami az adott mappában van, majd futtatom az alul találhatót.

    Tudnátok segíteni abban, hogy hogyan tudnám módosítani olyan módon, hogy miután egy fájlból bemásolta az összes sort, törölje ki azokat a sorokat, amiknek bármelyik (vagy ha így nem lehet, akkor I és M oszlopban) cellájában q vagy r szerepel.

    Azért lenne erre szükségem, mert 16-17 ezer sorosak a fájlok, amiket importál a makró, viszont mindegyiknek körülbelül harmadában szerepel q vagy r érték, amelyek számomra haszontalan adatok, így rengeteg helyet spórolhatnak (közel vagyok az 1 millió sorhoz, és ha azt túllépem, nem másolja tovább a makró dolgokat).

    Az alábbi makrót használom az importálásra. Segítenétek módosítani?

    Köszönöm szépen.

    Sub pasteall()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim PL, files As Variant
    Dim i, j As Long
    Dim k, l, m, n As Long
    Dim wbname As String



    ' select this workbook and clear all the input sheets

    wbname = ThisWorkbook.Name

    Workbooks(wbname).Activate
    Sheets("Data Sheet").Activate
    Range("D4:U1000000").ClearContents


    'copy data

    For i = 1 To Range("WorkbookCount").Value

    workbookpath = Range("Workbook_Name_Header").Offset(i, 0)
    PL = Range("Desk_Name_Header").Offset(i, 0)
    files = Range("File_Name").Offset(i, 0)




    Workbooks.Open (workbookpath)

    Sheets("Data").Activate
    Range("A65000").Select
    Selection.End(xlUp).Select

    l = Selection.Row
    Range("A2:W" & l).Select
    Selection.Copy


    Workbooks(wbname).Activate
    Sheets("Data Sheet").Activate
    Range("A1035000").Select
    Selection.End(xlUp).Select

    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    Workbooks(files).Activate
    ActiveWorkbook.Close


    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


    End Sub

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