Hirdetés

Keresés

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

  • Delila_1
    veterán

    Na most úgy néz ki,hogy tök szuper lett!!!! :C

    Extraként olyat meg lehet neki adni,hogy melyik héttel kezdje az ellenőrzést?
    Tehát minden maradna,ahogy most van csak felugrana egy ablak,ahol megkérdezné melyik héttel kezdjek.
    Az Excel1-ben a "B"-oszlopban 1-52.-ig lennének számok és azt szeretném,ha feljönne egy kérdés ahol lenyíló füllel kiválasztható lenne tól-ig meddig futtasa végig az ellenőrzést majd a felugrott ablakon belül egy INDÍT gomb megnyomásával a makró végigfutna.

    Ha ez nem fér bele az sem gond,mert már így is tök szuper,de akkor lenne igazán tökéletes. :R

    A makrót írd át.

    Sub Parosit()
    Dim usor As Long, sor As Long, utvonal As String
    Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook
    Dim WF As WorksheetFunction, TalalSor As Long
    Dim kezd As Long, vegez As Long


    Set WB1 = Workbooks("Excel1.xlsm")
    Set WF = Application.WorksheetFunction
    utvonal = "F:\Eadat\Excel fórumok\PH\"

    kezd = Application.InputBox("Add meg a kezdő hét sorszámát", "Kezdő hét", , , , , , 1)
    vegez = Application.InputBox("Add meg a záró hét sorszámát", "Záró hét", , , , , , 1)

    kezd = WF.Match(kezd, Columns(2), 0)
    vegez = WF.Match(vegez, Columns(2), 1)

    Application.StatusBar = "Nyugi, dolgozom"
    Application.ScreenUpdating = False

    usor = WB1.Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row

    'Excel2-ből I oszlop az Excel1 G-be
    Workbooks.Open Filename:=utvonal & "Excel2.xlsx"
    Set WB2 = Workbooks("Excel2.xlsx")
    WB1.Activate

    For sor = kezd To vegez
    If Cells(sor, "G") = "" And Cells(sor, "A") <> "" Then
    TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
    Cells(sor, "G") = WB2.Sheets("Munka1").Cells(TalalSor, "I")
    End If

    If Cells(sor, "J") = "" And Cells(sor, "A") <> "" Then
    TalalSor = WF.Match(Cells(sor, "A"), WB2.Sheets("Munka1").Columns(1), 0)
    Cells(sor, "J") = WB2.Sheets("Munka1").Cells(TalalSor, "J")
    End If
    Next
    WB2.Close False

    'Excel3-ból I oszlop az Excel1 K-ba
    Workbooks.Open Filename:=utvonal & "Excel3.xlsx"
    Set WB3 = Workbooks("Excel3.xlsx")
    WB1.Activate

    For sor = kezd To vegez
    If Cells(sor, "K") = "" And Cells(sor, "A") <> "" Then
    TalalSor = WF.Match(Cells(sor, "A"), WB3.Sheets("Munka1").Columns(1), 0)
    Cells(sor, "K") = WB3.Sheets("Munka1").Cells(TalalSor, "I")
    End If
    Next
    WB3.Close False

    Application.StatusBar = False
    Application.ScreenUpdating = True
    End Sub

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