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

• #14947 Delila_1 veterán #05304832 #14943

  Új Válasz 2012-09-14 10:52:17 #14947

  Ú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 #05304832 #14943 üzenetére

  Ha jól értem, egy lapon van sok, változó számú sorod.
  Az adatok az A:L tartományban vannak.
  Előfordulnak teljesen megegyező sorok.
  Ezeket kell kigyomlálni, hogy az azonosakból csak 1 maradjon, és a sorban feltüntetni, hogy a törlés előtt hány volt az egyes duplikált sorból.

  Sub Gyomlal()
  Dim sor%, usor%, usor1%
  usor% = Range("A1").End(xlDown).Row
  
  'Adatok összefűzése az N oszlopba
  Range("N1") = "Összefűzve"
  Range("N2:N" & usor%) = "=A2&B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&L2"
  
  'Irányított szűrés az U oszlopba
  Range("N1:N" & usor%).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  "U1"), Unique:=True
  
  usor1% = Range("U1").End(xlDown).Row 'U oszlop alsó sora
  
  'AD oszlopba darabszám
  Range("AD1") = "Db"
  Range("AD2:AD" & usor1%).FormulaR1C1 = "=COUNTIF(R2C14:R" & usor% & "C14,RC[-9])"
  
  'M oszlopba FKERES-sel darabszám
  Range("M1") = "Egyedi tétel"
  For sor% = 2 To usor%
  Range("M" & sor%) = Application.WorksheetFunction.VLookup(Range("N" & sor%), Range("U:AD"), 10, 0)
  Next
  
  'Azonos sorok törlése
  For sor% = usor% To 2 Step -1
  If Application.CountIf(Range("N:N"), Range("N" & sor%)) > 1 Then _
  Range("A" & sor% & ":M" & sor%) = ""
  Next
  
  'Segédoszlopok adatainak törlése
  Columns("N:AE").ClearContents
  End Sub

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