- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- sh4d0w: Csak a profit - emberélet nem számít
- gban: Ingyen kellene, de tegnapra
- Klaus Duran: 2025 dude
- Mr Dini: Mindent a StreamSharkról!
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- laskr99: Újrakezdem a processzor és videókártya szilícium magok fotózását
- sziku69: Fűzzük össze a szavakat :)
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
Új hozzászólás Aktív témák
-
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
- OHH! Dell Precision 7560 Tervező Vágó Laptop -70% 15,6" i7-11850H 32/1TB NVIDIA A3000 6GB FHD
- Asztali PC , i7 6700K , 1080 Ti 11GB , 32GB DDR4 , 500GB NVME , 500GB HDD
- Asztali PC , R5 8400F , RTX 3070 , 32GB DDR5 , 500GB NVME , 2TB HDD
- Legion Go 1TB
- Lenovo LOQ 15IRX9 - i5 13450HX, 16GB, RTX 4060 8G, 1TB M.2 (Gari: 2027.03.11.)
- Azonnali készpénzes nVidia RTX 2000 sorozat videokártya felvásárlás személyesen / csomagküldéssel
- BESZÁMÍTÁS! Gigabyte A620M R5 7500F 32GB DDR5 512GB SSD RX 6700 XT 12GB ZALMAN S3 TG CM 700W
- AKCIÓ! Lenovo Thinkpad P15 Gen1 15 FHD notebook - i7 10750H 16GB RAM 512GB SSD Quadro T1000 W11
- HP OMEN MAX 16T-AH000 - Ultra 9 275HX, 32GB, 1TB SSD, NVIDIA RTX 5090
- Xiaomi Redmi Note 14 Pro 256GB Kártyafüggetlen 1Év Garanciával
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest