Ahoj,
potřeboval bych vytřídit seznam jmen.
Mám dva listy na jednom jsou abecedně řazena jména a na druhém listě taktéže, ale je jich tam daleko více.
A já bych potřeboval aby tady na tomto listě nějakou fcí nebo makrem zůstali jen ta samá jména jak na tom prvním listě
a ostatní řádky se jmény aby se odstranily.
Děkuji
Vymazat rozdíl listů excelu Vyřešeno
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Vymazat rozdíl listů excelu
Pro jednorazove pouziti.
Na druhem listu vloz do pomocneho sloupce vzorec (uprav rozsah prohledavane oblasti):
=KDYŽ(JE.CHYBHODN(SVYHLEDAT(A1;List1!$A$1:$A$3;1;NEPRAVDA));"";"*")
kopiruj podle poctu radku
oba sloupce setrid podle pomocneho sloupce sestupne a odstran radky bez znaku "*" v pomocnem sloupci.
Na druhem listu vloz do pomocneho sloupce vzorec (uprav rozsah prohledavane oblasti):
=KDYŽ(JE.CHYBHODN(SVYHLEDAT(A1;List1!$A$1:$A$3;1;NEPRAVDA));"";"*")
kopiruj podle poctu radku
oba sloupce setrid podle pomocneho sloupce sestupne a odstran radky bez znaku "*" v pomocnem sloupci.
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Vymazat rozdíl listů excelu
Aha to bylo lehčí než jsem myslel, já to dělal podobně ale s využitím více slopců.
Dále jsem tady "cmuchal" na fóru a vzorec jsem nějak převed do makra a pro více listů.
Dále jsem zde našel výmaz řádku podle podmínky viewtopic.php?f=35&t=45216&hilit=%C5%99%C3%A1dek+odstran%C4%9Bn%C3%AD
Ale nedaří se mi to udělat pro jiný/é list/y. Dělá to pořád na akivním listě.
Jediné co se mi podařilo tak odstranit z původního makra okno kde se zadával znak do okna (inputbox) a zadávat tento znak přímo v makru.
Ale aby nevyskakovalo ani první okno kde se zadává oblast a zadávalo se to též pevně v makru se mi nedaří.
Kdo mi poradí, Nebo to odstranění řádku udělá dle sebe.
Kdyžtak v příloze je připravený soubor jak to mám dělané.
Dále jsem tady "cmuchal" na fóru a vzorec jsem nějak převed do makra a pro více listů.
Kód: Vybrat vše
Sub duplikace()
Dim Wsht As Worksheet, Blk As Range, Cll As Range
' pro vsechny listy
For Each Wsht In ThisWorkbook.Worksheets
' mimo listy kterých se to netýká
If Wsht.Name <> "prehled" Then
' zjisteni duplicity jmen na dvou listech
With Wsht
' definovat blok vyhledavani
Set Blk = Wsht.Range("C7:C18")
' napsat u shodnych jmen "*" a neshodnych "*N*"
For Each Cll In Blk.Cells
With Cll
.Value = "=IF(ISERROR(VLOOKUP(RC[-2],prehled!R7C1:R18C1,1,FALSE)),""*N*"",""*"")"
End With
Next Cll
End With
End If
Next
End Sub
Dále jsem zde našel výmaz řádku podle podmínky viewtopic.php?f=35&t=45216&hilit=%C5%99%C3%A1dek+odstran%C4%9Bn%C3%AD
Ale nedaří se mi to udělat pro jiný/é list/y. Dělá to pořád na akivním listě.
Jediné co se mi podařilo tak odstranit z původního makra okno kde se zadával znak do okna (inputbox) a zadávat tento znak přímo v makru.
Ale aby nevyskakovalo ani první okno kde se zadává oblast a zadávalo se to též pevně v makru se mi nedaří.
Kód: Vybrat vše
Sub OdstranRadek()
Dim MyArea As Range, Podminka As Variant
Dim Ofs As Long, Clmn As Range
Set MyArea = ActiveSheet.UsedRange
If IsEmpty(MyArea) Then End
Application.ScreenUpdating = False
'*********************
' odstrani radek, kde bunka v bloku bunek splnuje podminku
'*********************
On Error Resume Next
Set Clmn = Application.InputBox("Zadej blok s prazdnymi bunkami, pr: D5:D10", Type:=8)
If Err.Number <> 0 Then Exit Sub
If Clmn.Columns.Count > 1 Then MsgBox "Lze zadat pouze 1 sloupec": Exit Sub
Podminka = "*" 'Znak podle ktereho se mazou radky
On Error GoTo 0
Ofs = Clmn.Rows.Count - 1
Set Clmn = Clmn.Resize(1, 1)
Do ' odstraneni radku
If Clmn.Offset(Ofs, 0).Value = Podminka Then Clmn.Offset(Ofs, 0).EntireRow.Delete
Ofs = Ofs - 1
Loop While Ofs > -1
Range("a1").Select
Application.ScreenUpdating = True
End Sub
Kdo mi poradí, Nebo to odstranění řádku udělá dle sebe.
Kdyžtak v příloze je připravený soubor jak to mám dělané.
- Přílohy
-
- duplicita vice listu.xls
- (60.5 KiB) Staženo 33 x
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Vymazat rozdíl listů excelu
Je velice chvalihodne, ze ses pusti do samostane prace s VBA.
Zatim ti poradim ja dal v procedure Duplikace, jedno z moznych reseni:
Po dobehnuti smycky For Each Cll In Blk.Cells setrid blok podle pomocneho sloupce (nahraj si makro, uprav) a pak v pomocnem sloupci identifikuj blok bunek s indikatorem na odstraneni, rozsir pres vsechny sloupce a ClearContents.
Az se tim prokouses, tak zkusime jiny postup. Ano?
Zatim ti poradim ja dal v procedure Duplikace, jedno z moznych reseni:
Po dobehnuti smycky For Each Cll In Blk.Cells setrid blok podle pomocneho sloupce (nahraj si makro, uprav) a pak v pomocnem sloupci identifikuj blok bunek s indikatorem na odstraneni, rozsir pres vsechny sloupce a ClearContents.
Az se tim prokouses, tak zkusime jiny postup. Ano?
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Vymazat rozdíl listů excelu Vyřešeno
To stebou souhlasím. "Ať se trochu potrápí"
Bohužel mi to nejde setřídit podle pomocného sloupce, zkoušel jsem to přes autofiltr kde jsem
1) byl schopen na všech listech setřídit shodná a neshodná jména, ale nebyl jsem schopen nějak smazat ty nechtěné řádky
2) a ještě jsem pak ztroskotal na tom když jsem přidal nějaká data do sloupce B pak se to filtrovalo prvním filtrem a nebyl jsem schopen to filtrovat až tím třetím.
Asi jdu na to nějak špatně
Edit 19:00
Ještě se my podařilo udělat toto, ale to my jde jinak v krokování a jinak v auto.
Jeto sice krkolomné, ale mám to.
Bohužel mi to nejde setřídit podle pomocného sloupce, zkoušel jsem to přes autofiltr kde jsem
1) byl schopen na všech listech setřídit shodná a neshodná jména, ale nebyl jsem schopen nějak smazat ty nechtěné řádky
2) a ještě jsem pak ztroskotal na tom když jsem přidal nějaká data do sloupce B pak se to filtrovalo prvním filtrem a nebyl jsem schopen to filtrovat až tím třetím.
Kód: Vybrat vše
With Wsht
With .Range("C6")
.Value = "duplikace"
End With
For Each Cll In Blk.Cells
With Cll
.AutoFilter Field:=1, Criteria1:="~*N~*"
End With
Next Cll
End With
Asi jdu na to nějak špatně
Edit 19:00
Ještě se my podařilo udělat toto, ale to my jde jinak v krokování a jinak v auto.
Kód: Vybrat vše
Sub DelRows()
'
Dim Wsht As Worksheet, Blk As Range, Cll As Range
Dim Podminka As Variant, Ofs As Long
' pro vsechny listy
For Each Wsht In ThisWorkbook.Worksheets
' mimo listy kterých se to netýká
If Wsht.Name <> "prehled" Then
' zjisteni duplicity jmen na dvou listech pro vymaz
[color=#FF8000]With Wsht[/color]
' definovat blok vyhledavani
Set Blk = Wsht.Range("C7:C19")
'smaz radky dle podminky
For Each Cll In Blk.Cells
[color=#FF8000]With Cll[/color]
Podminka = "*" 'Znak podle ktereho se mazou radky
Ofs = Blk.Rows.Count - 1
Set Blk = Blk.Resize(1, 1)
Do ' odstraneni radku'
If Blk.Offset(Ofs, 0).Value = Podminka Then Blk.Offset(Ofs, 0).EntireRow.Delete
Ofs = Ofs - 1
Loop While Ofs > -1
Range("A1").Select
End With
Next Cll
End With
End If
Next
'
End Sub
Jeto sice krkolomné, ale mám to.
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Outlook - složky v AJ, nelze vymazat Příloha(y)
od janakailana » 03 bře 2024 08:21 » v Kancelářské balíky - 6
- 1965
-
od janakailana
Zobrazit poslední příspěvek
03 bře 2024 11:16
-
-
-
Outlook - složky v AJ, nelze vymazat Příloha(y)
od huklorcz » 15 bře 2024 22:20 » v Kancelářské balíky - 5
- 2474
-
od mmmartin
Zobrazit poslední příspěvek
15 bře 2024 23:52
-
-
-
Excel - automatický export listů xls do pdf včetně pojmenování Příloha(y)
od kalosek » 28 čer 2023 20:31 » v Kancelářské balíky - 2
- 3339
-
od kalosek
Zobrazit poslední příspěvek
29 čer 2023 19:39
-
-
- 10
- 3653
-
od lucaso84
Zobrazit poslední příspěvek
01 kvě 2024 12:11
-
- 0
- 3043
-
od Jsimi
Zobrazit poslední příspěvek
06 úno 2024 22:43
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti