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

• #14890 Delila_1 veterán CHANNIS #14882

  Új Válasz 2012-09-09 07:30:49 #14890

  Ú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 CHANNIS #14882 üzenetére

  Küldöm az ígért makrót. A lista1 nálam az első lapon van, a lista2 pedig a másodikon.
  Ezt adom meg a két 'Set =' kezdetű sorban.

  Sub alma()
  Dim sor%, tol%, ig%, usor%, nev$, aktual%
  Dim WS1 As Worksheet, WS2 As Worksheet
  Set WS1 = Worksheets(1)
  Set WS2 = Worksheets(2)
  usor% = WS2.Range("J" & Rows.Count).End(xlUp).Row
  
  For sor% = 3 To usor%
  nev$ = WS2.Range("J" & sor%)
  aktual% = Application.WorksheetFunction.Match(nev$, WS1.Columns(2), 0)
  tol% = aktual%
  Do While WS1.Cells(aktual%, 2) = nev$
  aktual% = aktual% + 1
  Loop
  ig% = aktual% - 1
  
  WS1.Rows(ig% + 1).EntireRow.Insert
  WS1.Cells(ig% + 1, 1) = WS1.Cells(ig%, 1)
  WS1.Cells(ig% + 1, 2) = WS1.Cells(ig%, 2)
  WS1.Cells(ig% + 1, 4) = WS2.Cells(sor%, "K")
  
  WS1.Rows(ig% + 2).EntireRow.Insert
  WS1.Rows(ig% + 3).EntireRow.Insert
  WS1.Cells(tol%, 4) = "=SUM(D" & tol% + 1 & ":D" & ig% + 3 & ")"
  Next
  End Sub

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