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

• #8603 Delila_1 veterán medium84 #8596

  Új Válasz 2010-11-08 20:01:39 #8603

  Ú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

  Privát üzenet küldése

  

  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