Excel makro - duplicity ve dvou listech

[kourasable]

Dobrý den,

potřeboval bych trochu pomoci s makrem do Excelu, které poměrně rychle potřebuji, bohužel jsem však nikdy makra netvořil.
Co potřebuji: mám 2 listy s nějakými daty, což je celkem jedno, důležité je, že v každém je jeden sloupec s emaily. Já oba sloupce pořebuji porovnat, a pokud tam bude nějaká shoda v emailu, tak v takovém případě vymazat celý řádek z listu2.

Naznačím malým algoritmem, který mě napadl, bohužel nevím, jak ho zapsat do excelu.

Kód: Vybrat vše

Sub nahrada()

    For I = 0 To Rows.Count
      For J = 1 To Worksheets("List2").Rows.Count
        IF (Range(Cells(I,6)).Text = Worksheets("List2").Range(Cells(J,3)).Text)
          Rows(Worksheets("List2").J).Delete
        End If
      Next J
    Next I

End Sub


Ten druhý cyklus začíná 1 kvůli tomu, že je to o řádek pošoupnuté.

Díky moc, snad jste mě pochopili :-)

[Reklama]

[Branscombe]

Dobrý den, a proč nepoužijete funkci "odebrat duplicity" ? Nebo si nahrajte tuto funkci jako makro a to pak použikte pokud opravdu potřebujete řešit problém makrem.

[kourasable]

Na funkci "odebrat duplicity" jsem se díval, ovšem já mám data jednak ve dvou listech (což by teda takový problém nebyl), ale především mám data, podle kterých budu duplicity hledat, pokaždé v jiném sloupci, takové nastavení již jsem tam nenašel.

A jak se tedy nahrává funkce jako makro? To by mi mohlo dost pomoci.

[cmuch]

Ten náznak by v excelu vypadal takto

Kód: Vybrat vše

Sub nahrada()
    For I = 1 To Rows.Count
      For J = 2 To Worksheets("List2").Rows.Count
        If Cells(I, 6).Text = Worksheets("List2").Cells(J, 3).Text Then
          Worksheets("List2").Rows(J).Delete
        End If
      Next J
    Next I
End Sub

Možná by byl lepší nějaký sešit s ukázkou co je potřeba řešit.

[Mirdad69]

Posílám 2 různá řešení:

Sub Delete_Dupl()
Application.ScreenUpdating = False

'poslední řádek v listu, ve kterém vybírám hledané hodnoty
'použil jsem sloupec A, obecně je to sloupec, ve kterém se předpokládá vyplněná hodnota ve všech řádcích
LR_L1 = Sheets("List2").Range("A65000").End(xlUp).Row
'poslední řádek v listu, ve kterém chci smazat duplicity
LR_L2 = Sheets("List1").Range("A65000").End(xlUp).Row
For I = 2 To LR_L1
For J = 2 To LR_L2
label1:
'to co hledám je ve sloupci A, hledaný text je ve sloupci E
If Sheets("List2").Cells(I, 1) = Sheets("List1").Cells(J, 5) Then
Sheets("List1").Rows(J).Delete Shift:=xlUp
'nesmím se posunout, protože po výmazu se z řádku J+1 stal řádek J
GoTo label1
End If
Next J
Next I

End Sub

Sub Delete_Dupl2()
Application.ScreenUpdating = False
I = 2
J = 2
'předpoklad je, že hodnoty jsou v kontrolovaných sloupcích jsou vyplněny a neprázdné, jinak cyklus skončí
Do While Not IsEmpty(Sheets("List2").Cells(I, 1))
Do While Not IsEmpty(Sheets("LIst1").Cells(J, 1))
If Sheets("List2").Cells(I, 1) = Sheets("List1").Cells(J, 5) Then
Sheets("List1").Rows(J).Delete Shift:=xlUp
Else
J = J + 1
Sheets("LIst1").Cells(J, 1).Select
End If
Loop
I = I + 1
J = 2
Loop

End Sub