Hirdetés
-
PROHARDVER!
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
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- MS SQL Server 2016, 2017, 2019
- Humble szökevények 500-2500Ft
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest
Fferi50

