- Ndruu: Segíts kereshetővé tenni a PH-s arcképeket!
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- ricshard444: Fényképező ? Telefon helyett
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- eBay-es kütyük kis pénzért
- Austin F.: MOD Android: Appok teljes képernyőn – immerzív mód
- Szoszo94: Xiaomi Mi Router 3G - Padavanra fel!
- Lalikiraly: Astra kalandok @Harmadik rész
Ú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
- LG OLED42C41LA 7 hónapos 2,5 év garancia.
- Szép Dell Precision 5560 Slim Tervező Vágó Laptop -70% 15,6" i7-11850H 64/1TB RTX A2000 4GB UHD 4K
- Acer Nitro V 16 AI Gamer Laptop! Ryzen 7 260/RTX 5070/32gb DDR5/2TB SSD/2560x1600/180hz/Beszámítok!
- Szép Dell Precision 5560 Slim Tervező Vágó Laptop -70% 15,6" Xeon W-11955M 64/1TB RTX A2000 4GB FHD+
- AOC CQ27G2S Monitor (2K/VA/165hz)
- Lenovo ThinkPad 40AF docking station (DisplayLink)
- Lenovo ThinkPad dokkolók: USB-C 40A9/ 40AY/ 40AS/ Thunderbolt 3 40AC/ Hybrid USB-C DisplayLink 40AF
- AKCIÓ! Gigabyte B760M i5 14600KF 64GB DDR4 512GB SSD RTX 3080 10GB Corsair 4000D Airflow 1000W
- Dell Latitude 5495 Full HD IPS Ryzen 5 pro 2500u Radeon Vega Mobile Gfx i5-8350u verő Bp MPL Foxpost
- AKCIÓ! AMD Ryzen 9 7950X 16 mag 32 szál processzor garanciával hibátlan működéssel
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest