[es] - VBA - Brisanje istog reda u dva sheeta

neptuncokg
Predrag M
racunovodja
Kragujevac

Član broj: 230353
Poruke: 326
109.93.72.*

+9 Profil

VBA - Brisanje istog reda u dva sheeta

^{30.12.2009. u 21:18 - pre 174 meseci}

Uz pomoc makroa dolazi se do odredjene celije - promenljiva 'rb' , npr. Range("A11") u sheetu(1), da bi se obrisao ceo red te celije. Evo procedure

Code:
Private Sub optBrisanje_Click()

If txt9.Value <> "" Then
  Sheets("BAZA").Select

'PRONALAZI BROJ 'rb' I BRISE CEO TAJ RED
  Dim rb As Range
  Dim rngTest As Range
  Set rngTest = Sheets("BAZA").Range("A2:A500")
  For Each rb In rngTest
       If rb.Value = Val(txt9.Value) Then
           rb.EntireRow.Delete Shift:=xlUp  ' brise ceo red u Sheetu "BAZA"
       End If
  Next rb
End If

End Sub

Ako je rb = "A11" - brise se ceo red br. 11. I to je u redu.

Ne mogu da "pogodim" naredbu, koja bi u nastavku procedure izbrisala i u Sheetu 2 - isti - "11". red. Znaci, da posle brisanja 11. reda Sheeta("BAZA"), odmah izbrise i 11. red Sheeta(2). Probao sam sve sto je bilo logicno, ali nista nisam "pogodio".Hvala unapred. Pozdrav

_{[Ovu poruku je menjao Jpeca dana 31.12.2009. u 09:25 GMT+1]}

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
194.106.170.*

Sajt: www.gowi.rs

+109 Profil

Re: VBA - Brisanje istog reda u dva sheeta

^{31.12.2009. u 08:22 - pre 174 meseci}

Verovatno je problem što si pokušavao da brišeš red koristeći rb. Medjutim pošto je ova ćelija izbrisana zajedno sa celim redom nije moguće koristiti je u kodu posle brisanja.
Dakle rešenje je da sačuvaš broj reda u nekoj promenljivoj pre brisanja rb. Npr.

Code:

          intRow = rb.Row
          rb.EntireRow.Delete Shift:=xlUp  ' brise ceo red u Sheetu "BAZA"
          Worksheets(2).Rows(intRow).Delete  ' brise isti  red u Sheet 2

Inače za traženje zadatog stringa u opsegu efikasnije rešenje od petlje je korišćenje Range.Find metode - pogledaj primer korišćenja ove metode u VBA Helpu.

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

neptuncokg
Predrag M
racunovodja
Kragujevac

Član broj: 230353
Poruke: 326
109.93.72.*

+9 Profil

Re: VBA - Brisanje istog reda u dva sheeta

^{31.12.2009. u 10:52 - pre 174 meseci}

Potpuno si u pravu. Sve vreme sam pokusavao da iskoristim staru promenljivu rb. Sada je OK. Jedno znanje vise.
Pogledao sam u helpu primer za Range.Find. U svim svojim aplikacijama imam potrebu za tom vrstom pretrag. Vise puta sam pomoc na tu temu dobio na forumu. I ova petlja iz mog primera je tvoje resenje, koje konstantno koristim. Ako ne gresim evo primera iz helpa:

Code:
With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Ako nije problem, valjalo bi da malo "pojasnimo". Ovde su izmiksovane tri petlje - "With-End-With", "Do-Loop" i "If-Then" ,na ovako malom prostoru. (Uf..)

Hvala i pozdrav.

_{[Ovu poruku je menjao timmy dana 31.12.2009. u 13:36 GMT+1]}

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
*.3dnet.rs.

Sajt: www.gowi.rs

+109 Profil

Re: VBA - Brisanje istog reda u dva sheeta

^{01.01.2010. u 09:47 - pre 174 meseci}

Da budemo precizniji ne radi se o tri petlje nego o tri strukture.
a/ With...End With
b/ If...End If - uslovno grananje
c/ Do...Loop - petlja

With...End With jednostavno omogućuje skraćeno pisanje. Npr. .Find(2, lookin:=xlValues) bez navodjenja objekta Range na koji se ova komanda odnosi. Ovu strukturu lako možemo zanemariti, ako kod malo prepravimo. Čini mi se da je kod u tom slučaju čitljiviji - lakše ga je pratiti.

Code:
Set rngPretraga = Worksheets(1).Range("a1:a500")
Set c = rngPretraga.Find(2, lookin:=xlValues)
If Not c Is Nothing Then
      firstAddress = c.Address
      Do
            c.Value = 5
            Set c = rngPretraga.FindNext(c)
      Loop While Not c Is Nothing And c.Address <> firstAddress
End If

Evo sad kratko objašnjenje. Komanda

Code:
Set c = rngPretraga.Find(2, LookIn:=xlValues)

Trazi prvo pojavljivanje "2" u zadatom opsegu.

Code:
If Not c Is Nothing Then

Ispituje se da li je nešto nadjeno, i ako nije ide se iza End If. Ako jeste čuva se adresa prvog nadjenog pojavljivanja

Code:
firstAddress = c.Address

i izvršava se Do ... Loop petlja.
U petlji se zamenjuje na mestu prvog pojavljivanja upisuje 5 (takav je primer tu treba ubaciti akciju koju ti želiš)

Code:
c.Value = 5

i traži sledeće pojavljivanje

Code:
Set c = rngPretraga.FindNext(c)

Ukoliko postoji samo jedno pojavljivanje findNext će naći isto kao prvo, pa će se petlja izvrašavati samo ako je adresa sledećeg pojavljivanja različita od adrese prvog pojavljivanja i ako je nešto nađeno funkcijom findNext

Code:
Loop While Not c Is Nothing And c.Address <> firstAddress

I na kraju evo kako bi izgeldalo tvoj kod sa find. Pošto tražiš samo prvu vrednost praktično bi se oslobodio jedne petlje For...Next

Code:
Private Sub optBrisanje_Click()
Dim intRow As Long
Dim rb As Range
Dim rngTest As Range

If txt9.Value <> "" Then
'  Sheets("BAZA").Select -  ovo nije potrebno jer naknadno pozivas Sheets("BAZA")

'PRONALAZI BROJ 'rb' I BRISE CEO TAJ RED
  Set rngTest = Sheets("BAZA").Range("A2:A500")
  Set rb = rngTest.Find(txt9.Value, LookIn:=xlValues)
  If Not rb Is Nothing Then
          intRow = rb.Row
          rb.EntireRow.Delete Shift:=xlUp    ' brise ceo red u Sheetu "BAZA"
          Worksheets(2).Rows(intRow).Delete  ' brise isti  red u Sheet 2
  End If
End If

End Sub

Srećni praznici!

_{[Naknadno zamenjeno strSearch sa txt9.Value. Ja sam straSearch korisitio da bih lakše testirao]}

_{[Ovu poruku je menjao Jpeca dana 01.01.2010. u 13:45 GMT+1]}

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu