Excel-Odstranění duplicitních hodnot Vyřešeno

[Dieesels]

Dobrý den,
jsem tady opět z dotazem. Jakým způsobem (viz. obrázek), lze vymazat automaticky data, které jsou stejná(zeleně označeno). Konkrétně na příkladu, když bunky ve sloupcích "A","B","C" což je Jmeno, Pořadí, Hodnota jsou stejné, dojde automaticky k vymazání stejných hodnot (bunka A7:C7), hodnoty A4:C4 zůstanou.Následně posunutí následující hodnoty na místo té stejné. Ale pokud jsou stejné hodnoty pouze ve dvou bunkách (červeně označeno), tak k vymazání nedojde.
Zkoušel jsem to pomocí tohoto makra:

Kód: Vybrat vše

Sub del_obsah()
Sheets("List1").Select 'vyber List1
Range("A2:C1000").ClearContents
End Sub

plus funkce if, ale nějak se mi to nepodařilo zprovoznit.

[Reklama]

[mike007]

Pro vyhledání duplicit můžeš použít i vzorec : =SOUČIN.SKALÁRNÍ(($A$2:A2=A2)*($B$2:B2=B2))*($C$2:C2=C2). Ten zadej do druhého řádku a roztáhni až dolu. Poté stačí vyfiltrovat hodnotu větší jak 1 a ty řádky smazat - jedná se o duplicity. Viz příloha.

Duplicit se též můžeš zbavit pomocí rozšířeného filtru.

---

[Dieesels]

Nakonec jsem to udělal pomocí vba, které sice funguje, jen to má jednu malou vadu na kráse a to, že při stisknutí tlačítka se sice vymažou duplicitní hodnoty, ale posune se také jmeno, pořadí, hodnota o jednu bunku. Jak na to?..viz příloha

[mike007]

Namísto .delete dej Columns(1).Delete

[Dieesels]

Paráda, děkuji...

[Dieesels]

Ještě poslední dotaz, jak to udělat, aby se vymazali duplicitní hodnoty na listu2 a ne na listu1.

[navstevnik]

takto:

Kód: Vybrat vše

Sub DelDups()
  Dim rng As Range
  Application.ScreenUpdating = False
  With Worksheets("list2") ' jmeno listu
    .Columns(1).Insert
    Set rng = Intersect(.UsedRange, .Range("b:b")).Offset(0, -1)
    With rng
      .FormulaR1C1 = "=IF(SUMPRODUCT((R2C2:RC[1]=RC[1])*(R2C3:RC[2]=RC[2])*(R2C4:RC[3]=RC[3])*(R2C5:RC[4]=RC[4])*(R2C6:RC[5]=RC[5]))>1,"""",1)"
      On Error Resume Next
      .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
      On Error GoTo 0
      Columns(1).Delete
    End With
  End With
End Sub

[Dieesels]

Díky, ale když použiji to upravené makro, sice to vymaže duplicitní řádky, ale data se posunou o jeden sloupec, na místo volného místa se zobrazí jedničky (skalární součin), což patří k makru, ale nemělo by to zobrazovat. Viz obrázek
Ps: Když jsem krokoval upravené vba, tak se 1 také ukázaly, ale pak zmizely a bylo vše jak má.
Shrnutí: Na listu1 jsem vložil ovládací prvek tlačítko, přiřadil jsem mu vba, na listu2 se nachází data. Když jsem to krokoval, vše proběhlo správně, ale když jsem použil tlačítko umístěné na listu1, seklo se to, viz obrázek.

[navstevnik]

Pri kopirovani procedury do odpovedi (odstranoval jsem zbytecnosti) doslo ke ztrate "." pred prikazem Columns(1).Delete, v dusledku pak byl odstranen sloupec na aktivnim listu, tedy listu s tlacitkem.
Oprav si v procedure:

Kód: Vybrat vše

      .... 
      On Error GoTo 0
      .Columns(1).Delete
    End With
  End With
End Sub

PS: Nepouzivej ovladaci prvky z panelu nastroju Formulare, jsou pouze z duvodu kompatibility se starsimi verzemi Excelu. Pouzivel ovladaci prvky z panelu nastroju Ovladaci prvky, lze programove ovladat jejich vlastnosti a je k dispozici sada udalostnich procedur zefektivnujicich procedury.

[Dieesels]

Paráda, opravdu díky. Také jsem zkoušel porovnávat původní vzorec z novým, ale ta tečka mi unikla. Děkuji...