2. Fórumok
  3. Szoftverfejlesztés
  4. Visual Basic
Keresés

Hirdetés

!! SZERVERLEÁLLÁS, ADATVESZTÉS INFORMÁCIÓK !!
Talpon vagyunk, köszönjük a sok biztatást! Ha segíteni szeretnél, boldogan ajánljuk Előfizetéseinket!

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

  • #2915 Delila_1 veterán prodrakan #2914
    Új Válasz #2915
    Ú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

    Delila_1

    veterán

    válasz prodrakan #2914 üzenetére

    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