Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Algoritmus nebo pomoc v Excelu

Dobrý den potřeboval bych pomoc s algoritmem.
Potřeboval bych označit jednotlivé řádky... ne sloupce.
Potřeboval bych označit celé řádky pokud se v nějaké buňce v určitém řádku Vyskytné daný řetězec.
Takže aby mi v celém listu, v případě že se na řádku například 7 kterékoliv buňce objeví například název Tereza tak aby mi Excel označil celý tento řádek.
Jako aby zmodral.
V tom listu bude mnoho řádků ve kterých bude název Tereza v jednotlivých buňkách.
Já bych potřeboval ty řádky vyselektovat A nakopírovat všechny řádky kde je buňka s názvem Tereza do nového listu.
Když to udělám příkazem najít a vyhledat, tak se mi označí pouze jednotlivé buňky ve kterých je nápis Tereza ale neoznačí se mi celý ten řádek.
A označovat celé zátky posléze ručně je hodně zdlouhavé.
Tak bych se chtěl zeptat jestli neexistuje řešení.
Děkuji za odpovědi.

Jsou zobrazeny jen nové odpovědi. Zobrazit všechny
Předmět Autor Datum
Google: excel copy rows with specific text Např. https://spreadsheetplanet.com/select-rows-with-spe… nový
host 17.10.2021 19:54
host
Option Explicit Sub Kopiruj_TEREZU() Dim Oblast As Range Dim Radek As Range Dim Bunka As Range Dim K… nový
Siki83 17.10.2021 22:38
Siki83
Paráda, moc děkuji... Páni, to muselo dát práce. Díky moc. nový
fstary 22.10.2021 00:44
fstary
Uvažuju, jak tam ještě dostat input box se zadáním hledaného textu, když zítra bude třeba hledat Mař… nový
L-Core 22.10.2021 07:37
L-Core
Jednoduxho namiesto "Tereza" napíšeš searchString, ktorý bude vopred nastavený napríklad tým InputBo… nový
pozorovateľ 22.10.2021 08:11
pozorovateľ
Jo, to je ono. Dovolím si tedy upravit ten Sikiho kód: Sub Kopiruj_cokoliv() Dim Oblast As Range Di… nový
L-Core 22.10.2021 08:44
L-Core
Aj to sa dá ľahko vyriešiť, namiesto priameho porovnania obsahu bunky sa použije funkcia INSTR, čiže… poslední
pozorovateľ 22.10.2021 08:50
pozorovateľ
Option Explicit

Sub Kopiruj_TEREZU()
Dim Oblast As Range
Dim Radek As Range
Dim Bunka As Range
Dim KopirovanaOblast As Range

Set Oblast = List1.UsedRange

For Each Radek In Oblast.Rows
    For Each Bunka In Radek.Cells
        If Bunka.Value = "Tereza" Then
            If KopirovanaOblast Is Nothing Then
                Set KopirovanaOblast = Bunka.EntireRow
                Exit For
            Else
                Set KopirovanaOblast = Union(KopirovanaOblast, Bunka.EntireRow)
                Exit For
            End If
        End If
    Next Bunka
Next Radek

If Not KopirovanaOblast Is Nothing Then
    KopirovanaOblast.Copy List2.Range("A1")
    If ActiveSheet.CodeName = "List1" Then List1.Range("A1").Select
    MsgBox "Kopírování dokončeno.", vbInformation, "Hotovo"
Else
    MsgBox "Žádná data ke kopírování.", vbExclamation, "Varování"
End If

Set Oblast = Nothing
Set KopirovanaOblast = Nothing
Set Bunka = Nothing
End Sub

Jo, to je ono.
Dovolím si tedy upravit ten Sikiho kód:

Sub Kopiruj_cokoliv()
Dim Oblast As Range
Dim Radek As Range
Dim Bunka As Range
Dim KopirovanaOblast As Range

searchString = InputBox("Zadej hledaný text")

Set Oblast = List1.UsedRange

For Each Radek In Oblast.Rows
    For Each Bunka In Radek.Cells
        If Bunka.Value = searchString Then
            If KopirovanaOblast Is Nothing Then
                Set KopirovanaOblast = Bunka.EntireRow
                Exit For
            Else
                Set KopirovanaOblast = Union(KopirovanaOblast, Bunka.EntireRow)
                Exit For
            End If
        End If
    Next Bunka
Next Radek

If Not KopirovanaOblast Is Nothing Then
    KopirovanaOblast.Copy List2.Range("A1")
    If ActiveSheet.CodeName = "List1" Then List1.Range("A1").Select
    MsgBox "Kopírování dokončeno.", vbInformation, "Hotovo"
Else
    MsgBox "Žádná data ke kopírování.", vbExclamation, "Varování"
End If

Set Oblast = Nothing
Set KopirovanaOblast = Nothing
Set Bunka = Nothing
End Sub

Doplním, že kód nefunguje na čísla (vyhledat třeba "56") ani na části textu v buňkách (nenajde "Tereza" v buňce s "Tereza Nováková"). Hledání je také case sensitive, nenajde tedy "tereza".

Zpět do poradny Odpovědět na původní otázku Nahoru