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

• Delila_1 veterán

  #2915

  #2914 prodrakan

  2017-10-10 13:10:28

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #2914 prodrakan

  #2914 prodrakan

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

  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.

  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