PC-HELP.CZ

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.



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

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

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.

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.

Ten náznak by v excelu vypadal takto

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

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