Pojdi na naslednjo, če ni podatkov

[drglzr]

Pozdravljeni.

Nekaj časa je že minilo, kar sem se zadnjič "oglasil". Sem pa spet naletel na težavo. Priložena koda mi v določenem stolpcu poišče določeno ime in ko ga najde izbriše vse vrstice, v katerih se pojavlja. Nato enako naredi v naslednjem stolpcu in tako še nekajkrat. Vse je v redu, če ime najde. Težava pa nastane, če ga v posameznem stolpcu ni. Takrat pokaže MsgBox in iz meni neznanega razloga izbriše vse podatke na konkretnem listu. Torej se tudi v naslednjih stolpcih funkcija ne more pravilno izvesti (ker se nima nad čim).

Nekako bi želel doseči, da bi se v primeru, da določenega imena v stolpcu (konkretno AI) ni, izvedel pregled naslednjega stolpca (torej AH). Verjamem, da je to mogoče, verjetno celo ni ne vem kako komplicirano, vendar nikakor (niti na spletu) ne najdem rešitve. Mislim, da bi moral za "Else" namesto MsgBox dodati nek stavek, ki bi kodo napotil na naslednji stolpec (konkretno AH). Vendar pa se tega ne uspem domisliti.

Prosil bi za kakršnokoli pomoč.

Hvala. Drago

P.S. Verjamem tudi, da je priloženo mogoče zapisati tudi drugače (morda bi šlo lahko tudi hitreje), vendar je to zame (še vedno) ZNF.

Koda: Izberi vse

Dim Rng As Range
Range("A1:AI1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("AI1", Range("AI1").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
    With Sheets("List1").Range("AI:AI") 'preišče stolpec AI
        Set Rng = .Find(What:="Anton", _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True 'value found
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete

Range("A1:AI1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("AH1", Range("AH1").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
    With Sheets("List1").Range("AH:AH") 'preišče stolpec AH
        Set Rng = .Find(What:="Anton", _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True 'value found
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete

[admin]

Pozdravljeni,

odgovor je zares dokaj trivialen. Vi najprej nekaj iščete in če najdete, se tja postavite (iskano torej izberete) in nato izbor pobrišete. Ko pa tistega ne najdete, pa izpišete napako in ne izberete NIČESAR, nakar tisto, kar imate izbrano pobrišete... in ker ni izbrano nič pobrišete pač vse

Rešitev je torej preprosto v tem, da podatke brišete samo če jih najdete.

Koda: Izberi vse

Dim Rng As Range
Range("A1:AI1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("AI1", Range("AI1").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
    With Sheets("List1").Range("AI:AI") 'preišče stolpec AI
        Set Rng = .Find(What:="Anton", _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True 'value found
						Range(Selection, Selection.End(xlDown)).Select
						Selection.EntireRow.Delete
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With

Range("A1:AI1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort key1:=Range("AH1", Range("AH1").End(xlDown)), _
order1:=xlAscending, Header:=xlNo
    With Sheets("List1").Range("AH:AH") 'preišče stolpec AH
        Set Rng = .Find(What:="Anton", _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True 'value found
						Range(Selection, Selection.End(xlDown)).Select
						Selection.EntireRow.Delete
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With

PS: Seveda lahko to napište drugače, krajše in hitreje, a ni važno, glavno da deluje!

[drglzr]

Ne vem, če bi kdaj to "našel" (najverjetneje nikoli). Deluje, kot želim.

Hvala za pomoč.

Lp, Drago