Hirdetés
- MWC 2026: Megmutatta a Vivo az X300 Ultrát
- Google Pixel topik
- Apple Watch Sport - ez is csak egy okosóra
- Sokkal jobb ajánlat lett elődjénél az iPhone 17e
- One mobilszolgáltatások
- Milyen okostelefont vegyek?
- Magyarországon és Szlovákiában is debütált a Honor 600 Lite
- Xiaomi 17 Ultra - jó az optikája
- Okosóra és okoskiegészítő topik
- Külföldi prepaid SIM-ek itthon
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
veterán
válasz
medium84
#8596
üzenetére
Ezt a makrót abba a füzetbe másold be, ahol a 2 oszlopod van. Feltételeztem, hogy mindkét füzeted első lapján vannak az adataid. A makróban írd át a füzetek nevét (Elso, Masodik).
Sub Megjelol()
Dim sor As Integer, usor As Integer
Dim serial, c
sor = 2: usor = ActiveSheet.UsedRange.Rows.Count
For sor = 2 To usor
serial = Cells(sor, 1).Value
Windows("Masodik.xls").Activate
With Range("A:A")
Set c = .Find(serial, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
Cells(c.Row, 1).Font.ColorIndex = 3
Windows("Elso.xls").Activate
Range(Cells(sor, 1), Cells(sor, 3)).Font.ColorIndex = 3
Cells(sor, 2).FormulaR1C1 = "=VLOOKUP(RC[-1],[Masodik.xls]Munka1!C1:C2,2,0)"
Cells(sor, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],[Masodik.xls]Munka1!C1:C3,3,0)"
End If
End With
Windows("Elso.xls").Activate
Next
Range("B:C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Cells(1).Select
Application.ScreenUpdating = True
End Sub -
Új hozzászólás Aktív témák
- Canon MILC: EOS R és M topik
- Path of Exile 2
- Samsung Galaxy Felhasználók OFF topicja
- Pedzegeti az új Xbox irányát a Microsoft
- Hobby rádiós topik
- MWC 2026: Megmutatta a Vivo az X300 Ultrát
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- Milyen alaplapot vegyek?
- Energiaital topic
- Építő/felújító topik
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Játékkulcsok ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok
- Telefon felvásárlás!! Samsung Galaxy A20e/Samsung Galaxy A40/Samsung Galaxy A04s/Samsung Galaxy A03s
- Beszámítás! Logitech G920 Driving Force Racing kormány garanciával hibátlan működéssel
- ASTRO A50 WIRELESS HEADSET + BASE STATION 4th gen. fejhallgató
- Bomba áron dobozos Hp Laptop! /AMD Ryzen 5-7520U/8 GB/256 SSD/FHD/Garancia
- Gyári DELL, HP, LENOVO,Asus,Fujitsu laptop töltők, 27% ÁFA
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
